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INTRODUCTION 


To support work being done in the Instrument Electro-Optics Branch in remote sensing a decision was made to set 
up an in-house capability to compute line by line atmospheric transmission spectra. 

An available DEC 11/23 microcomputer was dedicated to this task; its VT100 terminal had been modified by 
another manufacturer to greatly enhance its graphics capability, so that plots of the computed spectra could be dis- 
played directly on the screen. 

The computer program, called MICTRA (for Microcomputer TRAnsmission calculations) is based on the LASER 
code published by the Air Force Geophysics Laboratory in 1978 (Reference 1); it uses the 1982 edition of the AFGL 
Atmospheric Absorption Line Parameters Compilation (Reference 9). 

The Air Force code was extensively reworked to allow execution on a desk top microcomputer and to generate 
transmission spectra rather than tables of extinction coefficients. The program treats absorption due to lines of water 
vapor, carbon dioxide and ozone throughout the spectrum, from the visible to the microwave region, plus certain 
“continuum” absorption effects, Rayleigh (molecular) scattering and aerosol absorption and scattering. The program 
does not include radiance calculations. 

The program described in this report, along with another program and a plot package developed by the author (to 
be published — see References 2 and 3) have proven useful in supporting work being done by the Branch in the de- 
velopment of a submillimeter heterodyne radiometer, in lidar studies in the five micrometer region and in feasibility 
studies for near infrared laser communications. 

The MICTRA program was developed by the author from a previous MICTRA routine developed in the Instrument 
Electro-Optics Branch; this earlier routine was based on the Air Force LASER routine. For clarity these three routines 
will be referred to as the “new” MICTRA routine, the “old” MICTRA routine and the Air Force routine, respec- 
tively. 

The old routine was constructed primarily by deleting unneeded portions of the Air Force routine. The most impor- 
tant deletions were: 

1. Restriction of the atmosphere and aerosol models to a maximum altitude of 15 km (as compared to the origi- 
nal 100 km) and deletion of the Voigt profile calculation; 

2. Restriction of the aerosol models, as functions of wavelength, to a small wavelength range centered at 5 
micrometers; 

3. Deletion of four of the seven atmospheric absorbing species handled by the Air Force routine — only water 
vapor, carbon dioxide and ozone were retained; 

4. Deletion of molecular (Rayleigh) scattering; 

5. Deletion of the 3. 5-4. 2 micrometer water vapor continuum and the 4-5 micrometer nitrogen continuum. 

These changes were made because MICTRA was needed primarily to support lidar work in the 5 micrometer region of 
the spectrum, at altitudes not exceeding about 15 km and involving water vapor, carbon dioxide and ozone. Below 15 
kilometers, and for wavelengths of 1 micrometer or more, the lines are mainly pressure broadened (so the Voigt pro- 
file is not needed for a reasonably accurate calculation), and Rayleigh scattering is significant only in the visible part of 
the spectrum. In the new version of MICTRA all but the first and third of the above features have been restored. 
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It should be noted that, for wavelengths shorter than 5 micrometers, the use of the Lorentz line profile in place of 
the Voigt profile becomes less accurate. At 5 micrometers, the ratio of the Voigt halfwidth to the Lorentz halfwidth 
(V/L) ranges from about 1.02 at 15 km altitude to 1.0006 at sea level. At 1 micrometer the V/L ratio ranges from 
1.38 at 15 km to 1.02 at sea level, and at 0.5 micrometers it ranges from 2.02 at 15 km to 1.06 at sea level. (All of 
these ratios hold to a good approximation for any of the three species included in the program: water vapor, carbon 
dioxide or ozone.) Because of this decrease in accuracy of the Lorentz approximation at shorter wavelengths it is 
planned to include the Voigt profile in the transmission calculation in the near future. 

Neither the old routine nor the Air Force routine calculated transmission spectra; rather, they calculated and printed 
out tables of absorption and extinction coefficients for all of the atmospheric layers and for the various atmosphere and 
aerosol models. 

The author’s main purpose in modifying the old MICTRA routine was to make it capable of calculating transmis- 
sion spectra over some given range of wavelength or frequency. 

The basic strategy used to accomplish this was to use the old MICTRA routines as subroutines called by a newly- 
created executive routine, which directs the calculation of the spectrum. The executive routine was also given extensive 
capability to prompt the user to type in information at the keyboard which is used to set up the run. 

In addition, the full tables of aerosol coefficients as functions of wavelength were restored, because new Branch 
uses for the program involved other regions of the spectrum than just the 5 micrometer region. It is planned to replace 
the aerosol models by newer models which take account of the effect of condensation of water vapor on the haze parti- 
cles, as a function of relative humidity. The full 100 km atmosphere and seven absorbing species may also be restored. 
As mentioned above, several effects included in the Air Force routine but deleted in the old MICTRA routine were 
also restored: Rayleigh scattering and the continuum absorption effects for water vapor at 3. 5-4. 2 micrometers and for 
nitrogen at 4-5 micrometers. 

An auxiliary plotting routine (PLOTSP) was written to display the spectra computed by the new MICTRA; this rou- 
tine uses a plot package designed and written by the author specifically for the microcomputer configuration used to 
run MICTRA (see Reference 3). 

Numerous other changes connected with the coding of the routines, were made, but these are too detailed to merit 
description here. (The various line files used in the calculation of the spectrum are described in the section of this 
report dealing with the structure of the program.) 

WHAT THE PROGRAM DOES 

The program calculates atmospheric transmission spectra on a line-by-line basis over a variety of paths, spanning an 
arbitrarily chosen wavelength or frequency range. Radiance effects are not included in the calculation. 

The path may be chosen to be horizontal, vertical or slanted at any zenith angle, and may extend between any two 
altitudes contained in the atmosphere model, which is a layered, flat model. 

The range covered by the spectrum may be chosen freely and may be specified in angstroms, micrometers, hertz or 
wavenumbers, depending on the preference of the user. 
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The atmosphere models used are three of the models used in the original Air Force program: the U.S. Standard At' 
mosphere, 1962 and two mid-latitude models for average summer and average winter conditions. The aerosol models 
used are those devised by Shettle and Fenn in 1976 (Reference 4). (A more recent version of these models is available, 
which includes the effects of relative humidity on the size of the aerosol particles; it is planned to include these models 
in the future.) The atmosphere models, which originally extended up to 100 km altitude, were modified to extend only 
to 15 km altitude, because higher altitude effects either were not needed for our work or were not significant. Also, of 
the seven main atmospheric absorbing species included in the original program, only three were retained: water vapor, 
carbon dioxide and ozone, because the other species were not essential for our work. 

The absorption line data used by the program are taken from the 1982 edition of the main tape compiled by the Air 
Force Geophysics Laboratory, which lists all the known absorption lines for the seven most important atmospheric ab- 
sorbing species, from the visible to the microwave region (References 5-9). Segments of line data needed are read 
from the Air Force tape, preprocessed into the form used by the program and stored on floppy disks. 

MICTRA computes a transmission spectrum by computing the transmission over a net of points spanning the chosen 
wavelength or frequency range; at each point the extinction coefficients are computed by adding up several effects: 

• The absorption due to all atmospheric lines (of water vapor, carbon dioxide and ozone) in a neighborhood of 
the current wavelength, chosen so that absorption due to the tails of more distant lines is negligible; 

• Molecular continuum absorption: the 3. 5-4. 2 and the 8-14 micrometer water vapor continua and the nitrogen 
continuum at 4-5 micrometers; 

• Rayleigh (molecular) scattering; 

• Aerosol absorption and scattering (at present the 1976 models of Shettle and Fenn are used; their newer 
models, which include the effects of relative humidity, will be incorporated in the near future). 

All these effects are computed for each of the atmospheric layers (there are fifteen 1 km-thick layers) which the 
chosen path traverses, and are combined to form the total extinction for the given wavelength, over the given path. 

The transmission values thus calculated over the chosen wavelength or frequency range are then stored in a disk file, 
for later display by the auxiliary plotting routine PLOTSP. 

The plotting routine allows the user the option of displaying the computed transmission values vs wavelength in 
either angstroms or micrometers or vs frequency in either hertz or wavenumbers, depending on the region of the spec- 
trum and on the preference of the user. Further, whatever scale is chosen may be displayed as increasing toward either 
the right or the left of the plot. 

Two types of spectral plots may be computed by MICTRA and displayed by the plotting routine: a “continuous” 
spectrum which consists of the transmission over an equally-spaced net of points, joined by line segments to give a 
continuous appearance, or an “overview” spectrum in which the transmission is computed only at the exact center of 
each line in the chosen range. In the overview type of spectrum the plot shows the continuous background transmission 
due to aerosol and molecular continuum effects as a straight line (a good approximation over small wavelength ranges), 
with the line-center values displayed as vertical lines coming downward from the continuum; the value at the bottom of 
each line is, of course, the correct total transmission at that wavelength. To avoid the problem of the equally-spaced 
grid of points in a continuous spectrum skipping over the centers of absorption lines, thus not showing the true depth 
of the line or even missing it entirely, the line-center wavenumbers are intercalated into the equally spaced grid; thus 
the bottoms of all lines are correctly shown. 
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The overview type of spectrum is intended to give a picture of the gross properties of the spectrum over a large 
range (but small enough to contain at most a few hundred lines, and to ensure that the linear approximation to the 
background continuum is good), while the continuous type of spectrum is intended to show the detailed structure of the 
spectrum, including the shapes of the lines, over a smaller range. 

The program allows the user to interactively control or select (at the terminal keyboard) many of the parameters 
and data sets used by the program and many of the functions provided by the program. For example, the user may: 
select any of the three atmosphere models and any of the aerosol models provided; select the path; change the sea-level 
values of temperature, pressure or other parameters in the program; specify the wavelength or frequency range of the 
spectrum; specify the fineness of the grid for a continuous spectrum; etc. The program also allows the user to interac- 
tively retain or reject any or all of the extinction effects, in order to see clearly how great each effect is, taken by 
itself. For example, the user may decide to compute a spectrum showing only the absorption due to lines, with no 
aerosol or molecular extinction considered; to see just how strong each line is by itself, the user could choose the 
neighborhood of surrounding lines to be so small that only the absorption due to each line by itself is computed. Fur- 
ther, any or all lines in the chosen range may be independently selected or rejected; this is accomplished by command- 
ing the program to display each line on the screen, and telling the program whether to include it. Provision is made to 
accept or reject not just individual lines, but also all lines of a given species or all lines in a freely chosen wavelength 
range; thus a spectrum could be computed which shows only ozone lines, for example, or even a single line. 

Any number of spectra may be set up and computed in a single run; this is made possible by the BATCH compiler, 
which functions for the microcomputer used as a kind of simplified job control language. Each spectrum is stored in its 
own disk file, and may later be displayed by the plotting routine. 

HOW TO USE THE PROGRAM 

The program was designed to use the interactive capability of microcomputers; the user communicates with the pro- 
gram through the terminal keyboard and the video screen. 

The user only needs to execute the command file RNMICB (which stands for “run the batch version of MIC- 
TRA”), which then takes over and directs the user to execute other command files, depending on the type of run. 
Three types of runs are provided: create a BATCH file which can be executed later to compute a spectrum; compute a 
spectrum by executing a previously created BATCH file; or both create and execute a BATCH file. 

If one of the last two run types is selected, the command file will automatically call MICTRA, after instructing the 
user to mount the proper floppy disk in the proper device; MICTRA will then take over and lead the user step-by-step 
through the run setup and execution. 

All data sets needed by the program are stored internally, with one exception: the line file must be supplied by the 
user. The line file is a segment of data condensed from the Air Force Geophysics Laboratory main tape, which is a 
compilation of about 190,000 atmospheric absorption lines spanning the spectrum from the visible to the microwave 
region. Because MICTRA is implemented on a microcomputer with no tape drive, it is necessary to take the needed 
segment of data from the Air Force tape and store it on a floppy disk. The segment of data also must be “condensed” 
before MICTRA can use it; this is accomplished by using the auxiliary routine LNEDIT. The condensing process con- 
sists of taking the lines from the tape, which are coded as character strings in ASCII, stripping away certain 
parameters not needed by MICTRA (primarily quantum identifications), and converting the remaining numbers from 
character strings to binary form. The resulting file is about one fourth the size of the unprocessed file; this allows 
rather large segments of line data to be stored on a floppy disk. 

Each computed spectrum is stored in a disk file, specified by the user upon prompting by MICTRA. The spectrum 
may be displayed by using the auxiliary routine PLOTSP, which instructs the user how to use it and prompts for any 
needed information or choices. 
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Because MICTRA leads the user through the run setup process, it is not necessary to list the required input here; 
the information and choices required by MICTRA may be clearly seen by examining the listing, which is well 
documented with explanatory comments. It might be noted that the sequence of items needed for setting up a run is not 
fixed; many choices are provided, and different choices will result in different sequences of input items. 

To eliminate the possibility that the user might wait for a long run to finish without any knowledge of what is going 
on, the program types each spectrum point (wavelength or frequency and transmission) on the screen as it is computed; 
thus the user can abort a run that looks useless, instead of waiting blindly for it to finish. 

STRUCTURE OF THE PROGRAM 

The basic organization of the program is shown in Figure 1. MICTRA is the driver and main computing module; it 
leads the user through the run setup process and directs the calculation of the spectrum. 

The logical flow of the spectrum calculation involves several nested loops. The outside loop steps through the se- 
quence of frequency points at which the transmission is to be calculated. For a continuous type spectrum this will be 
an equally-spaced grid of frequency points, spanning the desired frequency range; for an overview (line-center) type of 
spectrum the set of frequency points will be the exact centers of all the absorption lines contained in the frequency 
range. 

The next inner loop steps through the atmospheric layers contained within the altitude range spanned by the chosen 
atmospheric path. The innermost loop steps through the absorption lines contained in the frequency range of the 
spectrum. 

Thus, for each frequency the program calculates the total absorption coefficient for all the lines in each atmospheric 
layer, as well as the continuum absorption coefficients, the Rayleigh scattering coefficient and the aerosol absorption 
and scattering coefficients for each layer. These are all added up to give the total extinction coefficient for each layer. 
Then the transmission for each layer is computed using the usual decreasing exponential law for extinction (e**-depth, 
where depth is the product of the total extinction coefficient and the path length through the layer), and finally the 
transmission over the entire path is computed by multiplying together the transmissions for the various layers. 

The subroutines communicate with one another through the three COMMON blocks, which hold variables needed 
by more than one routine, as well as by arguments in the call sequences. 

The program needs two external data sets: a file containing the atmosphere and aerosol models and a file containing 
a segment of data from the Air Force line tape. The atmosphere model file is located on a floppy disk along with the 
program load module; it is automatically read into the program by subroutine SETUP and stored in one of the 
COMMON blocks. The line file must be supplied by the user; it is created by taking the needed segment of data from 
the Air Force tape and using the auxiliary routine LNEDIT to condense it into the form used by MICTRA. 

After the MICTRA routine has obtained the required information from the user (via the keyboard), it forms the run 
line file, which consists of the lines needed for the current run, by taking from the line file only those lines selected by 
the user in the run setup process. The run line file may contain all of the lines in the line file, some of them or none 
of them; the lines to be included may be selected individually, by species or by sub-ranges of the spectrum frequency 
range. 
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Global Variables 


UNLABELLED 

COMMON 

COMMON /BLK 1 / 
COMMON /SETUP/ 


DATA SETS 
»***«*»«• 

BLOCK DATA 
(in program) 


Atmosphere and 
aerosol models 
(disk file) 


Line file — 
segment of 
line data 
from Air 
Force tape 
(disk file) 


Run linefile- 
selected from 
line file for 
this run 
(disk file) 


"Window” 
line file- 
segment from 
run linefile 
centered at 
current fre- 
quency 
(disk file) 


Computed 
spectrum 
(disk file) 


Figure 1 . Basic Flow of MICTRA Program 


During the calculation of the spectrum subroutine RDTAPE forms a “window” line file for each frequency at 
which the transmission is to be computed; this consists of all the lines in the run line file which are contained in a win- 
dow of specified frequency width centered at the current frequency (the width is chosen by the user during the run 
setup process). The purpose of the window line file is to include, for the calculation of the absorption coefficient at the 
current frequency, all those lines within some neighborhood of the current frequency which will affect the absorption 
appreciably. If the user wants to calculate the absorption due to a single line as if it were isolated (even though it may 
actually have close neighbors which affect it), the window width may be chosen small enough to exclude all nearby 
lines. 

In the implementation of MICTRA used by the author on the DEC 11/23 microcomputer, the line file is located on 
a floppy disk, while the run file and the window file are located in a part of the computer memory which is treated as 
a disk (logically) by the system software; thus, the operation of the program is much faster than it would be if these 
files were located on floppy disks. (In the event that the run file or the window file is too large to fit into that part of 
the memory, it is automatically put in a file located on a DEC RL02 disk drive, which holds 10.4 megabytes and is 
much faster than a floppy disk drive.) 
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MEMORY REQUIREMENTS AND OPERATING SPEED 


The entire program (i.e., the load module) requires about 42 kilobytes of memory; this includes all the atmosphere 
and aerosol models, which are read into the program and stored internally. The line files should be small enough to fit 
onto a floppy disk. In the DEC computer being used by the author, which handles 8-inch double density floppy disks 
which hold 512 kilobytes, this allows the line files to hold up to about 20,778 lines, in the condensed form used by 
MICTRA; this should be large enough for most purposes. The auxiliary programs LNEDIT and PLOTSP, which 
respectively construct condensed line files and display the spectra, require about 13 and 32 kilobytes of memory, 
respectively. 

The time required to compute a spectrum varies greatly, depending on the type of spectrum (continuous or only line 
centers) and on other factors such as the wavelength or frequency range covered, the number of absorption lines con- 
tained in the range, the width of the window of lines which significantly affect the absorption at the current frequency, 
the fineness of the frequency grid, etc. In general, the calculation of a line-center plot is much faster than the calcula- 
tion of a continuous plot; the times may range from a few seconds for a line-center plot over a small interval to sever- 
al hours for a continuous plot over a large interval with many lines and a wide window. 

SOME EXAMPLES OF COMPUTED TRANSMISSION SPECTRA 

In this section, several examples of transmission spectra are shown exactly as they appear on the terminal screen 
when displayed by the auxiliary plotting routine PLOTSP; the plots were copied directly from the screen by a TEK- 
TRONIX hardcopy device. 

Figure 2 shows a line-center spectrum in the near infrared, from 8250 to 8300 angstroms. The spectrum was com- 
puted for a slanted path extending from the ground to the top of the atmosphere model (at 15 km altitude); the zenith 
angle was taken to be 51 degrees. The midlatitude summer atmosphere model was used, along with a very hazy aero- 
sol model; many of the lines show complete absorption (all the lines in this region happen to be water vapor lines). 

The plot gives a very clear overall picture of the absorption by water vapor and aerosols in this region. Figure 3 
shows a continuous plot of a part of the region, from 8270 to 8280 angstroms; from this plot it is clear that the lack of 
line shapes in Figure 2 does not detract much from the qualitative picture of the spectrum, at least in this region. Both 
of these plots were computed with a window halfwidth of 20 wavenumbers (i.e., all lines within 20 wavenumbers to 
each side of the current frequency were taken into account in computing the absorption), which gives a very accurate 
spectrum. 

Figure 4 shows a line-center spectrum in the submillimeter region, from about 180 to 200 micrometers. This spec- 
trum was computed for a vertical path extending from 10 to 15 km altitude (if computed from the ground up, the 
water vapor absorption is so strong and the lines so broadened that the spectrum is virtually flat — almost everything 
gets absorbed). The midlatitude summer atmosphere model was used; the aerosol model does not extend to the submil- 
limeter region, because the effect is negligible. To allow a very quick look — i.e., a fast (about 10 seconds) calcula- 
tion of the spectrum — the lines were effectively considered separately by taking the window halfwidth to be only 
0.001 wavenumbers; thus each line is shown as it would appear if no other lines were present. In this region both 
water vapor and ozone lines appear, but only water vapor lines were included in the spectrum. For comparison, the 
spectrum in Figure 5 was computed. This shows the same spectrum as Figure 4 does, but in a continuous form, to 
show its actual appearance. Also, the window halfwidth for this spectrum was taken to be 10 wavenumbers, so that it 
is more accurate. Because of this, and because a fine grid of points was used to span the spectral range, this spectrum 
took about 2 hours to compute. (It should be recalled that the exact line centers of all lines are intercalated into the 
grid, so that the line depths are accurately shown — there is no skipping over line bottoms due to grid points missing 
the line.) 
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It is interesting to note, from Figure 5, that the water vapor line at about 187 micrometers is extremely strong; the 
plot clearly shows other, weaker lines extending down from its very broad wing on the high wavelength side; on its 
low wavelength side there is another very strong line, which is mostly off the plot. Inspection of the line file shows 
that the strong line at 187 micrometers is in fact unusually strong; its intrinsic line strength is about 45 times greater 
than the strength of the next strongest line near it (except for the line only partly shown, which is even stronger), and 
is from two to six orders of magnitude greater than the strength of most of its neighboring lines. 

Lastly, Figure 6 shows a spectrum in which only the aerosol effects were computed, over the entire range of the 
aerosol model from 0.2 to 40 micrometers. This continuous plot shows very clearly how the aerosol absorption and 
scattering effects decrease markedly outside the visible region of the spectrum. The spectrum was computed over a 
vertical path extending from the ground to the top of the atmosphere, with a midlatitude summer atmosphere model 
and rather clear visibility (not much haze). The wavelength grid used was very fine, so that the spectrum shows all de- 
tails clearly. 

TESTING OF PROGRAM 

The MICTRA routine was initially tested by comparing its computed transmission values at selected wavelengths 
with hand calculated points; in all cases the results agreed very closely. 

The routine was then tested against an independent program developed by another group at the Goddard Space 
Flight Center (Reference 10). This program takes account of all lines within 20 wavenumbers of the frequency at 
which the transmission is being computed, and it uses a Voigt line profile. Transmission spectra were calculated, using 
both programs, in the 5 micrometer region of the spectrum, from 2045 to 2057 wavenumbers, using the 1982 version 
of the Air Force absorption line tape. Both programs computed the spectrum with good resolution: every 0.01 
wavenumber for the other program and every 0.04 wavenumber for MICTRA. The two calculated spectra were virtu- 
ally identical; any slight differences in transmission values, at most a few percent, could be attributed to the fact that 
the two programs were completely independent and thus could not give identical results. 
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Figure 2. Line Center Spectrum in Near Infrared. 
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This version of the MICTRA routine is designed to run in the BATCH mode; 
the purpose is to be able to calculate many transmission spectra with no 
operator attention. 

Three modes of operation are provided: 

1. Setup mode - the routine is run interactively to create 

a control file for the BATCH program. The 
file includes all input to MICTRA which is 
normally input interactively at the keyboard, 
using ACCEPT statements. 

2. Batch mode - the routine is run under the control of the 

BATCH program to calculate the spectra, 
using the control file set up in a previous 
run in the setup mode. 

3. Combined mode - the routine creates a BATCH file and executes 

it to compute any number of spectra, all in 
one run. 

This routine is mainly a driver for the subroutines that actually 
do the calculations of the transmission spectrum. It contains the 
following options: 

* The following data, options and parameters may be specified: 

* Atmosphere and aerosol models; 

* Sea-level temperature and pressure; 

* Sea-level concentrations of water vapor, C02 and 
ozone; 

* Absorption line file; 

* Spectral range of the calculated transmission spectrum; 

* "Overview" spectrum (large spectral range) showing 
transmission at Line centers only, with aerosol and 
molecular continuum effects also shown, or "continuous" 
spectrum (small spectral range) showing line shapes; 

* Wavenumber increment between calculated points 
(may be as small as 0.01 cm-1, or even less); 

* Width of the "window" over which absorption lines are 
included in the calculation of the absorption at the 
wi ndow center . 

* The spectra are not plotted as they are calculated, because BATCH 
takes so much space. (The spectra can be later plotted from the 
disk spectrum files, using PLOTSP.) 

* The computed spectra are saved on disk files. 

* A separate routine (PLOTSP) is available to plot the spectra. 
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ORIGINAL PAGE IS 
OE POOR QUALITY 


c 

c 

c 


c 


c 

c 


c 


BYTE 

★ 


INTEGER 
R E A L*4 
DIMENSION 


SPECIFICATION STATEMENTS 

reply. Unfit, spcfil, edmode, disp, ff, 

htunit, pthtyp, batmod, batmd, 

grdmod, eqspce, centrs, replys, replyp 

speces, pcount 

lownu, lastwn, molnam 

li n f i l < 1 5 ) , spcfil(15), keepsw(9), molnam(3) 


COMMON 

★ 


★ 


z ( 1 6 ) , p ( 3 , 1 6 ) , 

t(3,16) , w (3 , 3 , 1 6) ,cay(3,16) ,wg(3,3) , 
t a 2 < 1 6 ) , f a ( 6 f 6 1 ) ,asc(6,61),aab(6,61) , 
ha s ( 1 6) 


COMMON/BLK1/ dnu(16),chi(16),hz1(16),hz2(16),itp,jt,ksam 

COMMON/RSETUP/ bound, lownu, highnu,delnu,v, 

* iatmod,iarmdg,iarmdt,iarmds, 

* numpts,nlines,keepsw,iblayr,itlayr, 

* irsize, hzint(16),iaermd 

DATA mo l nam ( 1 ) / 1 H20 '/, mo l na m ( 2 ) / 1 C02 '/, mo l nam ( 3 ) / * 03 */ 

DATA f f / "01 4/ , l i n f i 1/1 5*"000 / , s pc f i l / 1 5*"000 / , batmd/'C'/ 

DATA eqspce/'E'/, centrs / ' C' / 

DATA C / 2 . 99792 5 E 1 0 / 



C 

C SET UP MODE OF OPERATION: COMMAND FILE SETUP OR CALCULATION UNDER BATCH 

C ///////////////////////////////////////////////////////////////////////// 
C 


type 4 

4 f o rmat ( / / 1 2 , 1 I s this run to set up a BATCH command file'/ 

• t2,'or to calculate spectra under BATCH control? (F or C) *,$) 

accept 5, batmod 

5 format < a 1 ) 


C 

IF (batmod .eq. * F 1 ) go to 6 
IF (batmod .eq. ' C * ) go to 9 
C 

C Open BATCH command file for input 

c 

C 

6 OPEN ( un i t =9 , name= ' S DO : B AT F I L . B AT ' , type='NEW*, disp= , KEEP , f 
* f o r m = * FORMATTED 1 , initials! ze = 2 00) 

C 

write (9,8) 

8 formatC $J OB* /'$RUN SD2:MICTRA.SAV'/*$DATA') 
write (9,5) batmd 


C OPEN FILE TO HOLD CALCULATED TRANSMISSION SPECTRUM 

C /////////////////////////////////////////////////// 

C 

9 type 2 

2 format (//t2,' Type name of file (including device) to store*/ 

* 1 2 , ' t h e computed transmission spectrum: *,$) 

a c c ept 3 , spcfil 

3 f o r ma t ( 1 5a 1 ) 

IF (batmod .eq. *F') write(9,3) spcfil 
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IF (BATMOD .EQ. 'C') 

* OPEN (unit=8, name=spcfil, type='NEW', disp='KEEP', 

* access=' SEQUENTIAL' , f o rm= 1 UN FORMATTE 0 ' f r e c o rd s i z e = 2 , 

* i n i t i a L s i ze=300) 

C 

C 

C CHOOSE PATH OVER WHICH TRANSMISSION IS TO BE COMPUTED 
C ////////////////////////////////////////////////////// 

C 

type 210 

210 format(//t2,'Set up path over which transmission is to', 

* t44,'be calculated:'//) 

C 

C Heights and path length in feet or meters? 

C 

C 

214 type 211 


211 

format ( t 1 0 , 

'Specify 

heights above sea level 

and path' 

• 



* 


1 51 , 

' length ' / 






* 


tio. 

' in 

feet 

or meters? ( F or M) : ' 

,$) 





accept 212, 

h t u ni t 






212 

format (al ) 









IF 

(batmod 

. eq . 

• F ' > 

write(9,212) htunit 






IF 

( h t u n i t 

. eq . 

'F') 

htconv = 3.048E-04 

! convert 

ft 

to 

km 


IF 

( h t u n i t 

. eq . 

'M' ) 

htconv = 1 . E-03 

! convert 

m 

1 0 

km 


IF 

( h t un i t 

. ne . 

' F ' 

.and. htunit .ne. 'M') 

go to 214 

1 

error corr 


C 

C Is the path horizontal, vertical or slanted? 

c 

c 

215 type 213 

213 format(/t10,'Is the path horizontal, vertical or slanted?', 

* 1 54 , ' (H, V or S) : ' ,$) 

accept 212, pthtyp 

IF (bat mod . eq. *F') write(9,212) pthtyp 
C 

IF (pthtyp .eq. 'H') go to 220 

IF (pthtyp .eq. 'V' .OR. pthtyp .eq. 'S') go to 240 

go to 215 ! error corr . 

C Setup for horizontal path 

C 

C 

220 type 221 

221 format(/t15,'The path is horizontal;'/ 

* t15,'we need the following information:'// 

* t20, 'Height of path (ft or m, <15 km): ',$) 

accept 222, pathht 

222 format (flO. 3) 

IF (batmod .eq. 'F') write(9,222) pathht 

phtkm = htconv * pathht ! pathheight in km 

C 

type 223 

223 format (/t20, ' Length of path (ft or m) : ',$) 
accept 222 , path In 

IF (batmod .eq. * F 1 ) write(9,222) pathln 

plnkm = htconv * pathln ! path length in km 

C 

call laynum (phtkm, layer, delht) ! get atm. layer number 

iblayr = layer 

itlayr = layer !, (top and bottom same) 

go to 12 
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C Setup for vertical or slant path 

c 

C 

240 type 241 

241 format(/t15,'The path is vertical or slanted;'/ 

* t15,'we need the following information:'// 

* t20, 'Height of lower end of path (ft or m, <15 km): *,$) 
accept 222, phtbot 

IF (batmod .eq. 'F') write(9,222) phtbot 
C 

type 242 

242 f o rma t ( / t 20 , ' He i gh t of upper end of path (ft or m, <15 km): ',$) 
accept 222, phttop 

IF (batmod .eq. *F*) write<9,222) phttop 
C 

secant = 1.0 ! set sec to 1 for vert, path 

IF (pthtyp .eq. 'V') go to 245 
C 

type 243 ! define sec for slant path 

243 format C / 1 2 0 , ' Zeni th angle of path, in degrees: ',$) 
accept 244, zenang 

244 format ( f 7 . 3 ) 

IF (batmod .eq. *F') write(9,244) zenang 

zangrd = (3.141593/180.) * zenang ! zenith angle in radians 

secant = 1 . / c o s ( zang rd ) 

C 

245 phbkm = htconv * phtbot 
phtkm - htconv * phttop 
call laynum (phbkm, layer, delht) 
iblayr = layer 
bot seg = 1 . - delht 
IF (delht .eq. 0.) botseg = 0. 

C 

call laynum (phtkm, layer, delht) ! top layer no. and segment 

itlayr = layer 
t opseg = delht 

IF (delht .eq. 0.) topseg = 1. 

C 

C READ IN ALL ATMOSPHERIC MODELS, INCLUDING AEROSOL MODELS, FROM DATA SET 2 
C ////////////////////////////////////////////////////////////////////////// 
C 

12 call setup ! set up all atmosphere models 

C 

C CHOOSE ATMOSPHERE AND AEROSOL MODELS 
C ///////////////////////////////////// 

C 

C Atmosphere Model 

C 
C 

20 

* 

* 

★ 

21 


type 20 

format (' 0', t2, 'which of the 3 atmosphere models do you want?'/ 
t10,'type: 1 for midlatitude summer model:'/ 
t17, *2 for midlatitude winter model;'/ 

t17, *3 for U.S. Standard model: ',$) 

ac cept 21 , i at mod 
format( il) 

IF (batmod .eq. *F') write(9,21) iatmod 


ht. of bottom of path (km) 
ht. of top of path (km) 
bottom layer no. and segment 
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c 

c 

c 

4000 

★ 

4001 
C 


4010 

C 

C 

C 

c 

22 


23 


C 

24 

25 

• 

★ 

★ 

★ 

26 
C 

27 

28 


C 

29 

C 

31 

32 


Aerosol Model 


TYPE 4000 

FORMAT ( //T2 , 1 The sea-level meteorological range for the'/ 
t2, 'aerosol models may be chosen from 5 km'/ 

1 2 , ' ( v e r y hazy) to 50 km (very clear); 1 / 

1 2 , ' t y p e the desired range in km: ' , $ ) 

ACCEPT 4001 , SLVIS 
FORMAT ( F6 . 2 ) 

IF (BATMOD .EQ. 1 F * ) WR I TE (9 , 4001 ) SLVIS 

DO 4010 1=7,16 ! construct interpolated 

FINT = (50.-SLVIS)/45. ! altitude scaling f a c - 

HZINT(I) = H Z1 ( I ) + FINT*(HZ2(I)-HZ1 (I)) ! tors for aer. models 

CONTINUE ! (Only below 9 km) 

Note: HZ1 = clear (50 km) scaling factors 
HZ2 = hazy ( 5 km) scaling factors 
(stored in COMMON / B LK1 / ) 

type 22 

format(//t2,'Does any part of the path lie between 1 / 

t2,'0 km (sea-level) and 2 km altitude? (Y or N): ',$) 

accept 23, reply 
format (al ) 

IF (batmod .eq. 'F') write(9,23) reply 
IF (reply .eq. 'Y') go to 24 
go to 27 

type 25 

f ormat ( 1 0 ' , 1 2 , ' wh i c h bounda ry- l ay e r (0-2 km) 1 , 
t32,'aerosol model do you want?'/ 

1 1 0 , 1 1 y p e : 1 for rural model; 1 / 

t16, *2 for tropospheric model;'/ 

t16, '3 for maritime model; 1 / 

t16, '4 for urban model: ',$) 

accept 26, iarmdg 
format ( i 1 ) 

IF (batmod .eq. 1 F 1 ) write(9,26) iarmdg 

type 28 

f o r mat ( / / t 2 , ' Does any part of the path lie between'/ 
t2,'2 and 9 km altitude? (Y or N): ',$) 

accept 23, reply 

IF (batmod .eq. 1 F * ) write(9,23) reply 
IF (reply .eq. 'Y') go to 29 
go to 31 

IARMDT = 2 

type 32 

format (/ /t2 , 1 Does any part of the path lie above 9 km altitude?', 
t 53 , ' (Y or N) : ' ,$) 

accept 23 , reply 

IF (batmod .eq. 'F') write(9,23) reply 
IF (reply .eq. 'Y') go to 33 
go to 39 
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33 type 34 

34 format <//t2 f 'Whi ch stratospheric aerosol model do you want?'/ 

* 1 1 0 , 1 1 y p e : 5 for clear (background stratospheric) 1 / 

* 1 1 6 , '6 for hazy (aged volcanic): 1 , $ ) 

ac c ept 26 , i a r md s 

IF (batmod .eq. * F ' ) write(9,26) iarmds 

C 

IF (IARMDS .EQ. 5) GO TO 4020 
IF (IARMDS .EQ. 6) GO TO 4030 
C 

4020 DO 4025 1 = 1 ,6 

HZINT(I) = HZ1 (I) 

4025 CONTINUE 
GO TO 39 

4030 DO 4035 1 = 1 ,6 

HZINT(I) = H Z 2 ( I ) 

4035 CONTINUE 
C 
C 

C MODIFY ATMOSPHERIC MODEL (AT SEA LEVEL ONLY) 

C ///////////////////////////////////////////// 

C 

39 type 40 

40 f o rma t ( / / t 2 , ' The following are sea-level values of some parameters'/ 

* t 2 , * i n the atmosphere model chosen; any of them may be changed:'//) 
C 

C Modify Sea-level Temperature 

c 

tfahr = (9. 0/5.0) * t ( i atmod , 1 6) - 459.67 ! convert t to Fahr. 

C 

type 41, tfahr 

41 format (t2 , 'Temperature (deg. F) - *,t30,f7.2, 

* 1 4 5 , 'change? (Y or N) : ' ,$) 

ac cept 42 , reply 

42 format ( al ) 

IF (batmod .eq. 'F') write(9,42) reply 
C 

IF (reply .eq. 'N') go to 45 
C 

type 43 

43 f o rma t ( t 1 5 , ' N e w v a L ue : ' , t 29 , ' ',$) 

accept 44, tfahr 

44 f o r ma t ( f 7 . 2 ) 

IF (batmod .eq. ' F ' ) write(9,44) tfahr 
C 

t(i atmod, 16) = (5./9.)*(tfahr+459.67) ! convert back to deg. K 

C 

C Modify Sea-level Pressure 

C 

C 

45 type 46, p ( i a t mod , 1 6) 

46 f o r ma t ( / t 2 , ' P r e s su re (millibars) - ',t30,f8.3, 

* t45, 'change? (Y or N): ',$) 

C IF (batmod .eq. ’ C ' ) write (8,47) p(i atmod, 16) 

ac cept 42 , reply 

IF (batmod .eq. 1 F ' ) write(9,42) reply 
C 

IF (reply .eq. 'N') go to 48 
C 

type 43 

accept 47, p(iatmod,16) 

47 format ( f 8 . 3 ) 

IF (batmod .eq. * F 1 ) write(9,47) p(iatmod,16) 
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c 

c 

c 


c 

c 

c 


c 

c 

c 

c 


c 

c 


c 

c 

c 

c 


c 

c 


Modify Sea-level Concentration of Water Vapor 


48 type 49, wg(iatmod,1) 

49 f o rma t ( / t 2 , 1 Wa t e r vapor cone, (mo l ecu l es /cm**2/ km) 

* 1 46 , el 0 . 2 , t61 , ' change? (Y or N): ',$) 

IF (batmod .eq. * C * ) write (8,51) wg(iatmod,1) 
accept 42, reply 

IF (batmod .eq. *F') write(9,42) reply 
IF (reply .eq. • N * ) go to 52 
type 50 

50 f ormat (t33 , 1 New va lue : 1 , t45 , ' ',$) 
accept 51, wg(iatmod,1) 

51 format (el 0 . 2) 

IF (batmod .eq. # F 1 ) write(9,51) wg(iatmod,1) 
Modify Sea-level Concentration of Carbon Dioxide 


52 type 53, wg(iatmod,2) 

53 f o rmat ( / 1 2 , 1 Ca rbon dioxide cone, (mo l ecu L es/ cm**2/ km) - ', 

* t46, elO. 2, t61 , 'change? (Y or N): ',$) 

accept 42, reply 

IF (batmod .eq. *F') write(9,42) reply 
IF (reply .eq. 'N') go to 54 
type 50 

accept 51, wg(iatmod,2) 

IF (batmod .eq. 'F') write(9,51) wg(iatmod,2) 

Modify Sea-level Concentration of Ozone 


54 type 55, wg(iatmod,3) 

55 f o rma t ( / 1 2 , 1 Ozone cone, (mo l ecu les /cm**2/ km) - ', 

• 1 46 , el 0 . 2 , 1 61 , 1 c hange ? (Y or N): ',$) 

accept 42 , reply 

IF (batmod .eq. 'F') write(9,42) reply 
IF (reply .eq. 'N') go to 69 
type 50 

accept 51, wg(iatmod,3) 

IF (batmod .eq. 1 F ' ) write(9,51) wg(iatmod,3) 


C SET UP MASTER LINE FILE FOR THIS RUN ( UN f o r ma 1 1 ed , sequential access) 

C ////////////////////////////////////////////////////////////////////// 
C 

C This master line file should contain ONLY H20, C02 and 03 lines (all 

C isotopes) in the region of the spectrum being investigated. 

C 


c 

Each record in the file should contain the 

following quantities, in 

c 

r 

UNformatted (i.e., binary) form: 



l 

c 

Wavenumber 

rea 1*4 


c 

Line Strength- 

ii 


c 

Line half-width 

M 


c 

Lower state energy 

ii 


c 

Isotope identification 

integer 

(coded) 

c 

Molecular species 

integer 

(1 , 2 or 3) 
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c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 

c 


c 


c 

c 


c 


c 


The exact definitions and units of these quantities are given in the 
documentation for the Air Force Line Catalogue. 

A line file in this format is called a M condensed" line file, to 
distinguish it from the original segment of line data taken from the 
AFGL tapes, which list the lines in ASCII (i.e., formatted) form. 

A linefile editing routine is available to "condense 11 desired 
segments of AFGL line data. 

69 type 70 

70 format ( ’0* ,t2, 'Type the name of the line file to be used: ' , $ ) 

accept 71, linfil 

71 format ( 1 5 A1 ) 

IF (batmod .eq. 1 F 1 ) write(9,71) linfil 

OPEN ( u n i t = 4 , name=Linfil, type='0LD', form=' UNFORMATTED 1 , 

* di s p = ' KEEP* ) 

COUNT NUMBER OF LINES IN MASTER LINE FILE, 

NOTE FIRST AND LAST WAVENUMBERS AND 
DISPLAY THIS INFORMATION ON SCREEN 
(in both frequency and wavelength units) 
///////////////////////////////////////////// 


type 710 

710 f ormat (//t2, 1 Is this LINFIL the same as the one used for the 1 / 

• t2,' immediately preceding spectrum? (Y or N; type N ' / 

★ t 2 , ' i f this is the first spectrum for this run): ',$) 

accept 711, reply 

711 format(al) 

IF (batmod .eq. ' F * ) write(9,711) reply 
IF (reply .eq. 1 Y ' ) go to 726 

read(4) wavnum, strnth, hwidth, energy, isotop, speces 
frstwn = wavnum 
rewind 4 


DO 722 l i nc t =1 , 30000 

722 read(4, end=725) wa vnum , s t r n t h , h w i dt h , ene rgy , i so t op , spec es 


725 lastwn = wavnum 
mlines = linct-1 
rewind 4 


endl hz 
end2 h z 
endl a 
end2a 
endl me 
end2mc 


c* l a s t wn 
c*f rstwn 
1 . e8/ lastwn 
1 . e8/f rstwn 
1 .e4/ lastwn 
1 .e4/frstwn 


726 type 727, mlines, l a s t wn , f r s t wn , endl hz , end2hz , 

* endla, end2a, end1mc,end2mc 

727 format(//t2,'This line file contains l ,t34,I5,t 40, 'lines;'/ 

* 1 2 , 1 i t covers the frequency-wavelength range:'// 

* 1 30 , ' FROM' , 1 60 , 'TO'// 

* t5,' wavenumbers:' f t 25 , f 1 4 . 4, t 53 , f 1 4 . 4// 

* 1 5 , ' f r e q . in hertz:',t24,e16.9,t52,e16.9// 

* t5, 'angstroms:' f t 24 , f 1 5 . 4, t 52 , f 1 5 . 4// 

* t5,'micrometers:',t26,f12.4,t54,f12.4///) 
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c 

c 

c 


c 


c 


c 


c 


c 


c 

c 

c 

c 

c 


SPECIFY WAVENUMBER RANGE OVER WHICH TRANSMISSION IS TO BE CALCULATED 
///////////////////////////////////////////////////////////////////// 


730 

* 

★ 

★ 

★ 

★ 

* 


type 730 
format ( / / 1 2 , 
t2, 
1 2 , 
1 2 f 
1 2 , 
t2, 
1 2 , 
1 2 , 
t2. 


Type the endpoints, in either order, of the'/ 
spectral range over which the transmission is'/ 
to be computed; the endpoints may be expressed'/ 
in wavenumbers, hertz, angstroms or micrometers;'/ 


use the 

E format ( rea l ) . 1 

'// 


Type: 1 

for endpoints 

i n 

wa venumbe r s ' / 


2 

ii M 

it 

hertz*/ 


3 

it it 

ii 

angstroms'/ 


4 

ti H 

ii 

mi crometers: 

■ , $> 


731 


accept 731, iunit 
format(il) 

IF (batmod .eq. * F ' > write(9,731) iunit 


type 732 

732 format (//t10, 'One endpoint: ',$) 

accept 733, highnu 

733 FORMAT ( El 8 . 6) 

IF (batmod .eq. • F ' ) write(9,733) highnu 

IF (iunit .eq. 1) highnu = highnu ! convert to wavenumbers 

IF (iunit .eq. 2) highnu = highnu/c 

IF (iunit .eq. 3) highnu = 1.E8/highnu 

IF (iunit .eq. 4) highnu = 1.E4/highnu 


type 734 

734 f o r ma t ( / t 1 0 , ' Ot he r endpoint: ',$) 

accept 733, lownu 

IF (batmod .eq. 'F') write(9,733) lownu 

IF (iunit .eq. 1) lownu = lownu ! convert to wavenumbers 

IF (iunit .eq. 2) Lownu = lownu/c 

IF (iunit .eq. 3) Lownu = 1.E8/lownu 

IF (iunit .eq. 4) lownu = 1.E4/Lownu 

IF (lownu .It. highnu) go to 1999 ! interchange endpoints 

hghnu = highnu ! (if necessary) 

highnu = Lownu 
lownu = hghnu 


CHOOSE EQUALLY SPACED OR LINE CENTER GRID OF WAVELENGTH PTS 
//////////////////////////////////////////////////////////// 

1999 TYPE 2000 

2000 FORMAT ( /T2 Do you want to compute the spectrum:'// 

* t5,'o Over an equally spaced grid of wavenumbers (type E)'/ 

* t 5 , ' o Only at the absorption line centers (type C)'// 

* 1 2 , 1 ( I f no absorption Lines are to be used, you MUST type E): ',$) 

ACCEPT 2001 , GRDMOD 


2001 FORMAT ( A1 ) 




IF 

(BATMOD 

.EQ. 

• F ' ) WRITE(9,2001 ) GRDMOD 

IF 

(GRDMOD 

. EQ. 

EQSPCE) 

GO TO 79 

IF 

(GRDMOD 

.EQ. 

CENTRS) 

GO TO 89 
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c 


c 

c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 


79 type 80 

80 f o rmat ( ' 0 1 , 1 2 , ' Type the wavelength increment (in wavenumbers) 1 / 

* t2,'to be used in computing the transmission'/ 

* 1 2 , 'spectrum: ',$) 

a c c ept 81 , de l nu 

81 format (f15. 4) 

IF (bat mod .eq. * F') write(9,81) delnu 

xnmpts = ( h i g hnu- l ownu ) /de l nu + 1. ! corr. no. of points 

IF (xnmpts .It. 32000.) numpts = xnmpts 
IF (xnmpts .gt. 32000.) numpts = 32000 
type 82, numpts 

82 format(//t2 # 'This wavelength increment corresponds to'/ 

★ t2,'a total of ' , t14, i 5 , t20, 'points;'/ 

• 1 2 , ' is this number of points okay? (Y or N ) : ',$) 

accept 83, reply 

83 f o r mat ( al ) 

IF (batmod .eq. 1 F ' ) write(9,83) reply 
IF (reply .eq. 'N') go to 79 


SPECIFY WIDTH OF WAVENUMBER WINDOW IN WHICH LINES ARE CONSIDERED 
TO CONTRIBUTE TO THE ABSORPTION AT THE WINDOW CENTER 
////////////////////////////////////////////////////////////////// 

89 type 90 

90 format('0',t2 f 'Type the HALF-width, in wavenumbers, of the window'/ 

* t2 # 'over which you want lines to be included in calcu'/ 

* t2,'lating the absorption at the window center: ',$) 

a c c ept 91 , bound 

91 format (f12. 4) 

IF (batmod .eq. 'F') write(9,91) bound 

EXAMINE WAVENUMBER RANGE AND WINDOW WIDTH; 

IF RANGE, EXTENDED ABOVE AND BELOW BY WINDOW HALF-WIDTH, 

IS NOT CONTAINED IN MASTER LINE FILE, 

GO BACK AND RE-DEFINE THEM (UNLESS this spectrum is to show 
ONLY aerosol and/or molecular continuum effects, with NO 
absorption lines included - query user for this information) 
///////////////////////////////////////////////////////////// 

i b o t s w = 0 
i t o p s w = 0 

IF ( ( l ownu-bound) .It. frstwn) ibotsw = -1 
IF ((highnu+bound) .gt. Lastwn) itopsw = -1 
isumsw = ibotsw + itopsw 

IF (isumsw .eq. 0) go to 94 

IF(ibotsw .eq. -1) type 92 

92 format(/t2,'lownu-bound falls below the first line*/ 

* t2,'of the master line file - ') 

IF( itopsw .eq. -1) type 93 

93 format ( / 1 2 ,' hi ghnu + bound falls above the last line'/ 

* t2,'of the master line file - ') 
type 935 

935 f o r ma t ( / 1 2 , ' I s this spectrum to show ONLY aerosol and/or'/ 

* t2, 'molecular continuum effects, with NO absorption'/ 

* t2, 'lines included? (Y or N): ',$) 

accept 936 , reply 

936 format (al ) 
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IF (batmod . eq. ' F ' ) write (9,936) reply 
IF (reply .eq. 'Y') go to 94 
type 931 

931 format(/t2, l re-define lownu, highnu and/or bound: 1 ) 
go to 726 

94 IF (GRDMOD .EQ. CENTRS) PLTCOD = 1. 

IF (GRDMOD .EQ. EQSPCE) PLTCOD = 0. 

ANGMIC =0. ! output in angstroms or microns 


IF 

(1 .E8/LOWNU 

.GE. 1 

. E4 ) ANGMIC = 

i . 


IF 

(BATMOD 

. EQ. 

' C ' ) 

WRITE(8) 

PLTCOD, ANGMIC 


I F 

(BATMOD 

. EQ. 

' C ' 

. AND . 



★ 

ANGMIC 

. EQ. 

0. ) 

WRITE(8) 

1 .E8/HIGHNU.1 . 

E8/L0WNU ! ang 

IF 

(BATMOD 

. EQ. 

' C ' . 

AND . 



★ 

ANGMIC 

.EQ. 

1 . ) 

WRITE(8) 

1.E4/HIGHNU, 1 

.E4/LOWNU ! mic 

NON- 

PHYSICAL" 

SELECTION 

OF LINE, CONTINUUM OR AEROSOL 

EXTINCTION 


C ////////////////////////////////////////////////////////////////// 


C 


C 


C 


type 121 

121 format(//t2,'The user may want to arbitrarily select or eliminate'/ 

* t2,'the molecular absorption lines of a given species, 1 / 

★ t2, 'Rayleigh (molecular) scattering, any of the three'/ 

* t2, 'molecular conti nua, aerosol absorption or aerosol'/ 

★ t2, 'scattering; to allow this, the following options'/ 

• 1 2 , ' a r e provided; provision is made later for more'/ 

★ t2, 'flexible selection of absorption lines.'//) 
type 122 

122 format(t2, 'Eliminate or retain all water lines (E or R): ',$) 

accept 1 23 , rep l y 

1 23 format ( a 1 ) 

IF (batmod .eq. 'F') write(9,123) reply 

keepsw(l) = 1 

IF (reply .eq. 'E') keepswd) = 0 


type 124 
124 forma t ( 1 2 , 

* 'Eliminate or retain all carbon dioxide lines (E or R): .' ,$) 

a c cept 123, reply 

IF (batmod .eq. ' F ' ) write(9,123) reply 

keepsw (2) = 1 

IF (reply .eq. *E') keepsw(2) = 0 


type 125 

125 format (t2, 'Eliminate or retain all ozone lines (E or R): ',$) 

accept 123, reply 

IF (batmod .eq. 'F') write(9,123) reply 

keepsw(3) = 1 

IF (reply .eq. * E ' ) keepsw(3) = 0 


type 126 

126 format(t2, 'Eliminate or retain Rayleigh scattering (E or R): ',$) 

accept 123, reply 

IF (batmod .eq. 'F') write(9,123) reply 
keepsw(4) = 1 

IF (reply .eq. 'E') keepsw(4) = 0 
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c 


c 


c 


c 


type 127 
1 27 format (t 2 , 

* 'Eliminate or retain 3. 5-4.2 micron H20 continuum (E or R): ' , $ ) 

accept 123, reply 

IF (batmod .eq. 'F') write(9,123) reply 
keepsw(5) = 1 

IF (reply .eq. 1 E ' ) keepsw(5) = 0 


type 128 
128 f ormat ( 1 2 , 

* 'Eliminate or retain 8-14 micron H20 continuum (E or R): ',$) 

accept 1 23 , rep ly 

IF (batmod .eq. 'F') write(9,123) reply 
keepsw(6) = 1 

IF (reply .eq. *E') keepsw(6) = 0 


type 129 

129 format(t2, 'Eliminate or retain nitrogen continuum (E or R): ',$) 

accept 123, rep ly 

IF (batmod .eq. ' F ' ) write(9,123) reply 

keepsw(7) = 1 

IF (reply .eq. 'E') keepsw(7) = 0 


type 130 

130 format(t2, 'Eliminate or retain aerosol absorption (E or R): ',$) 

accept 1 23 , rep ly 

If (batmod .eq. ' F ' ) write(9,123) reply 
keepsw (8) = 1 

IF (reply .eq. *E') keepsw(8) = 0 


type 1 3 1 

131 format(t2, 'Eliminate or retain aerosol scattering (E or R): ',$) 

accept 123, reply 

If (batmod .eq. ' F ' ) write(9,123) reply 

keepsw(9) = 1 

IF (reply .eq. ’ E ' ) keepsw(9) = 0 


C SET UP THE LINE FILE FOR THIS RUN, BY TAKING THE APPROPRIATE LINES 
C FROM THE MASTER LINE FILE ENTERED ABOVE 

C //////////////////////////////////////////////////////////////////// 

C 

C Open the run line-file (unformatted, sequential access) 

C 

C 

OPEN ( un i t =3 , name= ' S C R : RUN F I L . D AT ' , type='NEW, d l sp= ' DE LETE ' , 

* form='UNFORMATTED', recordsize=6, initialsize=974) 

C 

C Set up interactive screening of lines 

C 

type 961 

961 format(//t2,'Do you want to interactively screen the lines'/ 

★ t2, 'before they are written to RUNFIL? (Y or N) : ',$) 

a c c ept 962 , reply 

962 format (al ) 

IF (batmod .eq. ' F ' ) write(9,962) reply 
C 

i u sed t = 0 

IF(reply .eq. ' Y ' > iusedt = 1 
C 

C Initialize line counts 

c 

nlines = 0 ! init. count of lines read to RUNFIL 

i read =0 ! " " " " " from LINFIL 


I 
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C Read a Line from LINFIL 

C 

c 

110 R E A D ( 4 # end = 200) wavnum, strnth, hwidth, energy, isotop, speces 
C *★*★★*★★★*★★★★★★★ 

C 

C Automatic screening 


I F 

(wavnum 

. It . 

( L ownu-bound ) ) 

go 

to 

110 

I F 

(wavnum 

.gt . 

( h i ghnu+bound) ) 

go 

to 

200 

IF 

( keeps w ( speces ) .eq. 0) 

go 

to 

110 


C 

C 

C 


C 


C 


C 

c 

c 


c 

c 


c 


Interactive screening 


IF (iusedt .eq. 0) go to 990 

iread = iread + 1 

IF (iread .eq. 1) go to 970 

go to 975 

970 type 971 ! first stop 

971 format(//t2,' Which mode do you want to use up to the next stop?'// 


★ 

1 1 2 , 1 R - 

reject 

a l l 

lines 

up 

to 

next 

stop'/ 

* 

1 1 2 , 1 I - 

include 

H 

H 

II 

• 1 

ii 

" ' / 

★ 

1 1 2 , 1 E - 

examine 

each 

line 

II 

II 

it 

" 1 / / 

★ 

t 2 , 'Type 

R , lor 

E: ' 

,$> 






accept 962, edmode 

IF (batmod .eq. 'F') write(9,962) edmode 


type 972 

972 f o rmat ( /t 2 , ' Type next wavenumber stop: ',$) 
accept 973, wnstop 

973 format ( f 1 0 . 4) 

IF (batmod .eq. 'F') write(9,973) wnstop 


go to 980 

975 IF (wavnum .le. wnstop) go to 980 
type 971 

accept 962, edmode 

IF (batmod .eq. ' F ' ) write(9,962) edmode 
type 972 

accept 973, wnstop 

IF (batmod .eq. ' F f ) write(9,973) wnstop 

980 IF (edmode .eq. 'R') go to 110 
IF (edmode .eq. 'I') go to 990 


succeeding stops 


type 385, mo L nam ( spece s ) , i so t op , wa vnum , s t r n t h , h w i d t h , ene rgy 
type 981 

981 format (/t2,' Type R to reject this line'/ 

* 1 2 , * T y p e I to include it: ',$) 

accept 962, disp 

IF (batmod .eq. 'F') write(9,962) disp 
IF (disp .eq. 1 R ' ) go to 110 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 

c 

c 

c 


c 


c 

c 

c 

c 


Write this Line (which is retained if this point is reached) 
into RUNFIL 


990 write (3) speces, isotop, wavnum, strnth, hwidth, energy 

Keep a running count of the number of Lines; 
go back and read the next line 

nlines = nlines + 1 

go to 110 


If RUNFIL contains no lines, decide whether to continue the run 


200 IF (nlines . eq . 0) go to 201 
go to 380 

201 type 202 

202 format (///t2 f 'No absorption lines in RUNFIL; 1 / 

• t2, 'continue run? (Y or N): ',$) 

accept 203 , rep Ly 

203 format ( al ) 

IF (batmod .eq. * F ' ) write(9,203) reply 

IF (reply .eq. 'N') STOP 
go to 399 

If RUNFIL contains any lines, do you want to display them 
on the screen and/or print them? 


380 type 381 , nlines 

381 format (//t2, 'There are' ,t12,I5,t18,' lines in RUNFIL;'/ 

* t2,'do you want to display them on the screen? (Y or N): ',$) 

accept 382 , rep l y s 

382 f o r ma t ( a 1 ) 

IF (batmod .eq. 'F') write(9,382) replys 

type 386 

386 f o r ma t ( t 2 , ' do you want to print them?'/ 

* 1 2 , ' (Turn on the printer!) (Y or N) : ',$) 

accept 382 , rep l yp 

IF (batmod .eq. ' F ' ) write(9,382) replyp 

IF (replys .eq. 1 N ' .AND. 

* replyp .eq. ' N ' ) go to 399 

Display and/or print lines in RUNFIL 


rewind 3 

DO 384 I =1 , n l i nes 

read(3) speces, i sotop, wavnum, strnth, hwidth, energy 
IF (replys .eq. 1 Y ' .and. I .eq. 1) type 388 

IF (replyp .eq. ' Y ' .and. I .eq. 1) print 388 

IF (replys .eq. 'Y') 

★ type 385, molnam(speces), isotop, wavnum, strnth, hwidth, energy 

IF (replyp .eq. 'Y') 

★ print 385, mo L nam ( s pe c e s ) , i s o t op , wa v num , s t r n t h , h w i d t h , en e rg y 
384 continue 

rewind 3 
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388 format(//t2, ‘species* , 1 1 0 , * isotope' ,t18, 'wavenumber* , 

* t33 , ' strength' ,t48,'halfwidth , ,t 60, ' l . s . energy') 
385 format </t2,a4,t10, i4, 1 1 8 , f 1 0 . 4 , 1 33 , el 0 . 3 , t48, f 8 . 4 , 1 60 , f 1 0 . 3 > 

C 

C Compute number of blocks required to store RUNFIL 

c 

C 

399 irsize = I F I X ( ( F LOAT ( n l i ne s ) / 5 1 2 . ) *24 . ) + 1 ! no. of blocks 

C 

C If RUNFIL size is less than 164 blocks, put RUNFIL in VM 

c 

C 

IF (irsize .GT. 164) go to 1507 
C 

OPEN ( un i t = 1 , name='VM:RUNFIL.DAT' , type='NEW', disp='KEEP', 

★ form=' UNFORMATTED' , recordsize = 6, in itialsize= irsize) 

C 

IFCnlines .eq. 0) go to 1509 
rewind 3 
C 

DO 1 508 , 1 1 = 1 , n l i nes 

read (3) speces, isotop, wavnum, strnth, hwidth, energy 
w r i t e ( 1 ) speces, isotop, wavnum, strnth, hwidth, energy 
1 508 cont i nue 


C 

1509 CLOSECuni t=3, d i s p= ' D E L ET E ’ ) 

CL0SE(unit=1 , disp='KEEP') 

OPEN ( un i t =3 , name= ' VM : RUN F I L . D AT ' , type='0LD', d i s p= ' D E LET E ' , 

★ form= ' UNFORMATTED ' , r e c o rd s i z e = 6 ) 

C 

C Close LINFIL 

C 

1 507 CL0SE(unit = 4,disp=*KEEP' ) 

C 

C Comments 

C 

C The line file for this run is now set up; it contains only those 

C lines for which the concentration is non-zero; the total number of 

C lines in RUNFIL is nlines; the wavenumber range contained in the 

C file is lownu- bound to highnu+bound. 

C 


IF (batmod .eq. ' F ' ) go to 800 

c 

C CALCULATION 

C ★★★★****★★*** 

C 

C To compute the absorption coefficient at each of the net of points 

C of separation delnu spanning the wavenumber range (lownu, highnu), 

C we compute, at each point of wavenumber v, the sum of the cont ri- 

C but ions from all lines which lie in the window (v-bound, v + bound); 

C for an overview spectrum the net of points consists of just the 

C line centers. 

C 

C 

C COMPUTE AEROSOL-ONLY TRANSMISSION AT HIGHNU AND LOWNU 

C (for use by PLOTSP in drawing the aerosol line 

C for a line-center plot) 

C ////////////////////////////////////////////////////// 

IAERMD = 1 
ATL = -1 . 

ATU = -1 . 
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V = HIGHNU 
GO TO 300 

C 

2900 IF (ATL .LT. 0.) GO TO 2910 
IF ( ATU .LT. 0.) GO TO 2920 
C 

2910 ATL = TRANS 

V = LOW N U 
GO TO 300 

C 

2920 ATU = TRANS 

WRITEC8) ATL, ATU 
IAERMD = 0 
C 
C 

C LOOP OVER NET OF POINTS SPANNING THE SPECTRUM 

C ////////////////////////////////////////////// 



IF (GRDMOD 

. EQ. 

EQSPCE) 

GO 

TO 

3000 



c 

IF (GRDMOD 

. EQ. 

CENTRS) 

GO 

TO 

3100 



3000 

v = lownu 





! 

start at low end 

of spectrum 


i = 1 





! 

index for net o f 

points 


i t opsw = 0 





! 

switch to jump out of loop 

r 

GO TO 300 








3100 

REWIND 3 









LNINDX = 0 








310 

READC3) SPECES, 

ISOTOP, 

WAVNUM, 

STRNTH , 

HWIDTH, ENERGY 



LNINDX = LNINDX 

+ 1 







IF (WAVNUM 

. LT. 

LOWNU) 

GO 

TO 

310 




FRSTLN = LNINDX 








I = 1 

V = WAVNUM 
C 

300 call rdtape ! loop over net of points 

C ************ ★ 

C 

C Go to section of code for given path type 

C 

C 

IF (pthtyp .eq. 'H') go to 1000 

IF (pthtyp .eq. 'V' .OR. pthtyp .eq. 1 S ') 

C 

C Horizontal path 

C 

C 

1 000 layer = iblayr 

extcof = cayCiatmod, layer) + aersol ( layer) 
trans = e x p ( -e x t c o f *p l n km ) 
waveno = v 
go to 1400 
C 

C Vertical or slant path 

c 

C 

1100 depth = 0 . 

C 


go to 1100 


! ext. coe f f . 

! transmittance 
! wavenumber 
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1110 

c 

c 


C Store this point in spectrum file (formatted, seq. access) 

C 

1400 IF (IAERMD .EQ. 1) 60 TO 2900 
C 

IF (angmic . e q . 0.) w r i t e ( 8 ) 1 ,e8/waveno, trans ! conv. to ang. 

IF (angmic .eq, 1.) write(8) 1.e4/waveno, trans ! conv. to mic. 

C 

C Type this point on the screen to show the user 

C the progress of the calculation 

c 

type 1401, waveno, trans 

1401 format (t 2, el 2.5, 1 18, f 8. 4) 

C 

C Test wavenumber to see if high end of range has been reached 

c 

IF (GRDM0D .EQ. EQSPCE) GO TO 350 
C 

REWIND 3 
LNINDX = 0 

351 READ (3 , END=800) SPECES , I SOTOP , W A VNUM , STRN TH , HW I DTH , EN E RG Y 
LNINDX = LNINDX + 1 

IF (LNINDX .EQ. FRSTLN+I) GO TO 355 
GO TO 351 

355 1=1+1 

V = WAVNUM 
WAVNOP = WAVENO 
TRANSP = TRANS 

IF (V .LE. HIGHNU) GO TO 300 
1 = 1-1 
GO TO 800 
C 

c 

350 rewind 3 

356 read (3 , end=358) spe c e s , i s o t op , wa vnum , s t rnt h , h w i dt h , ene r g y 
IF (wavnum .gt. v .and. wavnum .It. v+delnu) go to 357 

go to 356 

357 v = wavnum 
go to 359 

358 v = v + delnu 

359 i= i + 1 
C 

wavnop = waveno ! store these as "previous" values 

transp = trans 
C 

IF (v .gt. highnu) go to 3355 
go to 300 
0 ★★★★★★★★★ 
c 


DO 1110 lay e r=i t lay r , i b lay r 
l = layer 

extcof = c a y ( i a t mod , l ) + aersol(l) 
pathl = secant 

IF (l .eq. iblayr) pathl = bot seg* secant 
IF (l .eq. itlayr) pathl = t opseg * s e c ant 
depth = depth + extcof*pathl 
cont i nue 
★**★★★••* 

trans = exp(-depth) 
waveno = v 
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3355 IF (itopsw . eq . 1) go to 3356 
itopsw = 1 

v = h i g h n u 
go to 300 

C **★**★★** 

C 

3356 i = i - 1 ! correct the line count 


C 


800 


C 

1 560 
1561 


1 562 


C 


c lose(uni t=3 ,di sp = ' DELETE ' ) 


IF (batmod 

.eq. 

*c') 

c lose(unit=8 # d 

type 1560 

format (// t2 
accept 1561 
f o rmat ( al ) 

, 1 Do you 
, reply 

want to compute 

IF (batmod 

. eq . 

1 F 1 ) 

write(9 # 1561) 

IF (reply . 

eq . 

*Y') 

go to 9 

I F (batmod 

.eq. 

1 F 1 ) 

wri te(9 f 1562) 

format C ' $E0D ' / ' 

$ E0 J 1 

) 

IF (batmod 

. eq . 

1 F* ) 

CLOSE ( u n i t =9 


STOP 

END 


S p= 1 K E E P ' ) 

another spectrum? <Y or N): ',$) 

reply 

disp='KEEP') 


i 


t 


I 
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SUBROUTINE SETUP 


C 

C 

C 

c 

C A A B 

C ABSOR 

C AKCL 

C 

C AKHZ 

C 

C ALFAO 

C ALPHAL 

C ASHZ 

C 

C ARSMOD 

C ASC 

C ATMODL 

C BOUND 

C 

C CAS 

C 

C CAY 

C CHI 

C 

C CNCS 

C 

C CONST 

C 

C CS2 

C DELP 

C DELTAZ 

C DNU 

C 

C EPP 

C E V H 1 

C E V H 2 

C FA 

C FAC 

C 

C GNU 

C HAS 

C 

C H CON V 

C H Z 1 

c 

C HZ2 

C H 20 LA Y 

C I K 1 

C I T I 

C 

C ITP 

C II 

C JT 

C 

C KS AM 

C LC 

C LH 

C MOL 

C 

C 03 CON 

C P 


DICTIONARY OF SYMBOLS 


AEROSOL, ABSORPTION COEFFICIENT - INPUT DATA 
8-14 MICRON CONTINUUM ABSORPTION COEFFICIENT 
CLEAR AEROSOL ABSORPTION COEFFICIENT INTERPOLATED AT 
FREQUENCY V 

HAZY AEROSOL ABSORPTION COEFFICIENT INTERPOLATED AT 
FREQUENCY V 

LINE HALF WIDTH - INPUT FROM TAPE 
LORENTZ HALF-WIDTH 

HAZY AEROSOL SCATTERING COEFFICIENT INTERPOLATED AT 
FREQUENCY V 

AEROSOL MODEL - INPUT DATA 

AEROSOL SCATTERING COEFFICIENT - INPUT DATA 
ATMOSPHERIC MODEL - INPUT DATA 

LIMIT OUTSIDE OF WHICH LINE CONTRIBUTIONS ARE NOT 
CONSIDERED - INPUT DATA 

CLEAR AEROSOL SCATTERING COEFFICIENT (50 KM SEA LEVEL 
VISIBILITY) - OUTPUT DATA 

MOLECULAR ABSORPTION COEFFICIENT - OUTPUT DATA 
MODIFICATION TO THE LORENTZ LINE SHAPE FOR C02 

- INPUT DATA/BLK DATA 

NITROGEN-BROADENED WATER VAPOR CONTINUUM ABSORPTION 
COEFFICIENT 

<R*1 .0E-03) / <A*1 .0E + 05) . WHERE R IS GAS CONSTANT AND A 
IS AVOGADRO'S NUMBER 

PARTITION FUNCTION TEMPERATURE CORRECTION 
PRESSURE DIFFERENCE BETWEEN ATMOSPHERIC LEVELS 
DIFFERENCE BETWEEN TWO ADJACENT LAYERS 

FREQUENCY INCREMENT ASSOCIATED WITH LORENTZ MODIFICATION 

- INPUT DATA 

ENERGY OF LOWER STATE OF TRANSITION -INPUT FROM TAPE 

CLEAR VERTICAL SCALING FACTOR 

HAZY VERTICAL SCALING FACTOR 

AEROSOL MODEL FREQUENCY - INPUT DATA 

INTERMEDIATE INTERPOLATING DATA FOR THE AEROSOL 

FREQUENCY DATA 

LINE FREQUENCY - INPUT FROM TAPE 

HAZY: AEROSOL SCATTERING COEFFICIENT (5 KM SEA LEVEL 
VISIBILITY) - OUTPUT DATA 
0.1*3. 34E+22 M0LECULES/CM2 

VERTICAL SCALING FACTOR FOR CLEAR AEROSOL MODEL 

- INPUT DATA / B L K DATA 

VERTICAL SCALING FACTOR FOR HAZY AEROSOL MODEL 
WATER VAPOR CONCENTRATION 
ATMOSPHERIC MODEL INDEX 

MOLECULAR SPECIES IDENTIFICATION (1=H20, 2=C02, 

3 = 0Z0N E ) - INPUT FROM TAPE 

NUMBER OF ATMOSPHERIC LAYERS - INPUT DATA/BLK DATA 
NUMBER OF ABSORPTION LINES 

NUMBER OF ELEMENTS IN THE LORENTZ MODIFICATION FACTOR 

- INPUT DATA/BLK DATA 

NUMBER OF MODEL ATMOSPHERES - INPUT DATA/BLK DATA 
CLEAR AEROSOL MODEL INDEX 
HAZY AEROSOL MODEL INDEX 

MOLECULE IDENTIFIER (1= H20, 2= C02, 3= 03)-INPUT FROM 
TAPE 

CONVERSION FACTOR FROM GM/M**3 TO MO LE CU LE S / C M**2 
ATMOSPHERIC LEVEL PRESSURE - INPUT DATA 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PATH OPTICAL DEPTH AT LINE CENTER FOR 1 - KM SEA LEVEL PATH 

PBAR AVERAGE LAYER PRESSURE 

PH20 WATER VAPOR PRESSURE 

PI RATIO OF CIRCUMFERENCE OF A CIRCLE TO ITS DIAMETER 

S ABSORPTION LINE INTENSITY - INPUT FROM TAPE 

SEC SECANT ANGLE - INPUT DATA 

ST TEMPERATURE CORRECTED LINE INTENSITY 

T ATMOSPHERIC LAYER TEMPERATURE - INPUT DATA 

TA1 CLEAR: AEROSOL ABSORPTION COEFFICIENT - OUTPUT DATA 

TA2 HAZY: AEROSOL ABSORPTION COEFFICIENT - OUTPUT DATA 

TBAR AVERAGE LAYER TEMPERATURE 

V FREQUENCY AT WHICH THE EXTINCTION COEFFICIENT ARE BEING 

CALCULATED - INPUT DATA 

V BOT LOWER FREQUENCY LIMIT FOR THE LINE CONTRIBUTIONS. 

V BOT= V-BOUND 

VTOP UPPER FREQUENCY LIMIT FOR THE LINE CONTRIBUTIONS. 

VTOP= V+BOUND 

W ABSORBER CONCENTRATION 

WBAR MEAN WATER VAPOR CONCENTRATION FOR A LAYER 

WG SEA LEVEL VALUES OF MOLECULAR ABUNDANCES - INPUT DATA 

WH WATER VAPOR CONCENTRATION AT A SPECIFIC LEVEL-INPUT DATA 

WH1 SCALE HEIGHT ASSOCIATED WITH WATER VAPOR 

WH3 SCALE HEIGHT ASSOCIATED WITH OZONE 

WO OZONE CONCENTRATION AT A SPECIFIC LEVEL - INPUT DATA 

W03 MEAN OZONE CONCENTRATION FOR A LAYER 

WV WAVELENGTH CORRESPONDING TO FREQUENCY, V 

W 1 D INTERMEDIATE QUANTITY ASSOCIATED WITH COMPUTING 

INTEGRATED WATER AMOUNT 

W3D INTERMEDIATE QUANTITY ASSOCIATED WITH COMPUTING 

INTEGRATED OZONE AMOUNT 
XI LORENTZ LINE MODIFICATION VARIABLE 

Z ATMOSPHERIC HEIGHT (KM) - INPUT DATA 

ZDIST ABSOLUTE DISTANCE FROM THE LINE CENTER FREQUENCY V 




C 

C 

c 


c 


SPECIFICATION STATEMENTS 

★ ★★★★★★★★★★★★★★★★★★★★★★Hr** 


IMPLICIT INTEGER*2 (I-N) 

REA L*4 LOWNU 

DIMENSION ATMODL(3,5) , AR SMOD ( 6 , 5 ) , WH <3 , 1 6) , WO <3 , 1 6) , KEEPSW (9) 


COMMON 


* 


Z (1 6) , 

P(3,16) ,T (3,16) ,W (3,3, 16) , CAY (3,16) ,WG(3,3> , 
T A2 ( 1 6 ) , F A (6 , 61 ) ,ASC(6,61) ,AAB(6,61) , 

HAS (1 6) 


C 

COMMON /BLK1 / DNU(16),CHI(16),HZ1<16),HZ2C16),ITP,JT,KSAM 

COMMON /RSETUP/ BOUND , LOWNU , H I G HNU , DE LNU , V , 

• IATMOD, IARMDG, IARMDT, IARMDS, 

• NUMPTS,NLINES,KEEPSW, IBLAYR, ITLAYR, 

• IRSIZE, HZINTC1 6) , IAERMD 
C 

DATA HCONV, 03 CON/3. 34E + 21 ,1 .255E + 21 / 

C 

c*************************************************************************** 

c 


I 
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C READ ATMOSPHERIC MODELS FROM DATA SET 2 AND PROCESS THEM 
C ///////////////////////////////////////////////////////// 

C 

C OPEN DATA SET 2 (formatted, sequential access) 

C 

OPEN ( UN I T = 2 , NAME= , SD2:ATMMOD.DAT l , TYPE=*OLD*, 

* DISP =I KEEP 1 , FORM=' FORMATTED' ) 

C 

C READ SEA LEVEL VALUES OF MOLECULAR ABUNDANCES FROM DATA SET 2; 

C STORE THEM IN ARRAY WG 

C 

DO 1 1 = 1 ,3 ! I = atm. mode l 

READ (2,19) (WG(I,M) ,M = 1 ,3) ! M = molecule (H20,C02,03) 

1 CONTINUE 

C 

19 FORMAT (3 El 0 . 3 ) 


C 

C 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


READ THE NAMES OF THE ATMOSPHERIC MODELS AND THE DATA 


DO 300 J=1,3 ! read names 

************ 

READ (2,21) (ATMODLU ,M> ,M = 1 ,5) 

DO 200 L = 1 , 1 TP ! read data (L = 1-16) 

************ 

K=ITP-L+1 ! reverse numbering of Layers 

< K=1 6-1 ) 

READ (2,22) 2(K), P ( J , K) , T ( J , K> , UH ( J , K) , WO ( J , K) 

200 CONTINUE 

300 CONTINUE 

************ 

Z = height in kilometers 
P = pressure 
T = t empe ratu r e 

WH = water vapor concentration 
WO = ozone concentration 

21 FORMAT (5A4) 

22 FORMAT (F6.1, El 0 . 3 , F6 . 1 , 2E1 0 . 1 ) 

NOTE: The order of the atmospheric layers is reversed; 
i.e., K = 1-16 runs layers from top to ground. 

(K = 1 AT 15 KM,..., K = 16 at sea level.) 


COMPUTE THE AVERAGE LAYER CONCENTRATIONS OF H20, C02 AND 03 


NOTE: Molecular densities are assumed to decrease expo- 
nentially between consecutive levels; we compute 
the average layer value by integrating the expo- 
nential over the layer. If W1D or W3D approach 
zero, the log is poorly defined, so in this case 
we use just a simple average. 

K1=ITP-1 ! (= 16-1 = 15) 
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c 

c 


c 


c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


DO 7 1=1,3 ! atmospheric model loop (3 models) 

DO 7 K=1,K1 ! layer loop - from level 15 at top (K=1) 

************ ! to level 1 at 1 km <K=15) 

WBAR=(WH(I,K)+WH(I,K+1))/2.0 
W03=(W0( I , K ) +W0 ( I , K+1 ) ) /2.0 
DELTAZ=Z (K)-Z(K+1 ) 

W1 D = W H ( I , K) /WH ( I , K + 1 ) 

IF (ABS <W1 D-1 . 00) . LT .0 . 1 ) GO TO 3 
WH1 =-DELTAZ/ ALOGCW1 D) 

W(I,1 ,K)=WH1*HCONV*(WH(I,K+1)-WH(I,K)) ! water vapor cone. 

GO TO 4 

3 W ( I , 1 ,K)=WBAR*HCONV*DELTAZ ! 

4 W3D=WO(I,K)/WO(I, K+1) 

IF (ABSCW3D-1 .00) .LT.0.1) GO TO 5 
WH3=-DELTAZ/AL0G (W3D) 

W ( I ,3 , K)=WH3*03C0N*(W0( I , K+1 )-W0(I ,K)) ! ozone cone. 

GO TO 6 


5 W(I,3,K)=W03*03C0N*DELTAZ ! 

NOTE: THE MOLECULAR DENSITY IN A GIVEN LAYER OF C02 , 

A UNIFORMLY MIXED GAS, IS DIRECTLY RELATED TO 
THE PRESSURE INCREMENT BETWEEN THE LAYER BOUNDARIES. 
THE CONSTANT IN THE FOLLOWING EXPRESSION IS THE 
UNIFORMLY MIXED GAS CONSTANT FOR C02. 


6 W(J,2,K)=((P(I,K+1)-P<I,K))/1013.0)*7.102E+21 ! C02 cone. 

7 CONTINUE 


READ AEROSOL MODELS FROM DATA SET 2 
AND STORE THEM IN COMMON 


Aerosol models: rural - 1 

t roposphe r i c - 2 

maritime - 3 

urban - 4 

background 
s t ra t osphe r i c - 5 
aged volcanic - 6 

DO 10 1=1,6 

READ (2,25) (ARSMOD (I,M),M=1,5) ! read model names 

READ (2,26) ( F A ( I , J ) , A S C ( I t J ) , A A B ( I , J ) , J =1 , 61 ) ! read data 

10 CONTINUE 


25 FORMAT ( 5 A4 ) 

26 FORMAT (F8.3,2F7.5) 

00111=1,6 ! convert from microns 

DO 12 J =1 ,61 ! to wavenumbers 

F A ( I , J ) = 1 . 0E + 04/ F A ( I , J ) 

12 CONTINUE 
11 CONTINUE 
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C CLOSE ATMOSPHERE MODEL FILE 

C 

50 CLOSE (UNIT=2) 

C 

RETURN 

END 


SUBROUTINE RDTAPE 


C 

C This routine selects, from RUNFIL, those lines in the range 

C 

C (v-bound, v+bound) 

C 

C and stores them in the (unformatted) file VM:WINDOW.DAT. 

C 

C The number of retained lines, LINECT, is sent to subroutine ATMOS. 


C 

C 

C 

C 


SPECIFICATION STATEMENTS 
***★***★***★★★* *********** 


C 


c 


IMPLICIT INTEGERS (I-N) 
INTEGER SPECES, SWITCH 

REA L*4 LOWNU 

DIMENSION KEEPSW (9) 


COMMON Z ( 1 6 ) , 

* P (3 , 1 6) , T (3 , 1 6 ) , W (3 , 3 , 1 6 ) ,CAY(3,16) ,WG(3,3) , 

* TA2C16) , F A (6 , 61 ) ,ASC (6,61) , A AB ( 6 , 61 ) , 

* H AS ( 1 6 ) 


* 


★ 


COMMON/B LK1 / DNU ( 1 6 ) , C H I ( 1 6 ) , HZ1 ( 1 6 ) , H Z 2 ( 1 6 ) , I T P , J T , K S AM 

COMMON /RSETUP/ BOUN D , LOWNU , H I GH NU , D E LNU , V , 

IATMOD, I ARMDG , IARMDT, IARMDS , 

NUMPTS, N LINES, KEEPSW, IB LAYR, IT LAYR, 

IRSIZE, HZINTH6) , IAERMD 
OATA SWITCH/0/ 


C 

C OPEN THE VIRTUAL MEMORY FILE FOR THE WINDOW OF LINES 

C (unformatted, sequential access) 

C 

IF(IRSIZE .LE. 164) 

* OPEN (UNIT=10,NAME='VM:WINDOW.DAT' ,TYPE='NEW' ,DISP=' DELETE' , 

* F0RM=' UN FORMATTED’ ,REC0RDSIZE = 6,INITIALSIZE=IRSIZE> 

C 

IFCIRSIZE .GT. 164) 

* OPEN (UNIT = 10,NAME='SD3:WIND0W. DAT' ,TYPE=’NEW' , D I S P = ' D E L ET E ' , 

C * FORM=' UNFORMATTED' ,RECORDSIZE=6, INITIALSIZE=650) 


C READ, FROM RUNFIL, ALL LINES IN THE RANGE (V-BOUND, V+BOUND) 

C AND STORE THEM IN VM : W I N DOW . D AT 

C ///////////////////////////////////////////////////////////// 

C 

LINECT=0 ! initialize line count 

IF (NLINES .EQ. 0) GO TO 20 ! no lines, so no window file 

REWIND3 ! position pointer to beginning of 3 


33 


1 RE AD (3 , END = 20) SPECES, ISOTOP, WAVNUM, STRNTH , HWIDTH, ENERGY 


IF (WAVNUM .LT. V-BOUND) GO TO 1 
IF (WAVNUM .GT. V+BOUND) GO TO 20 

LINECT = LINECT + 1 

WRITE(IO) SPECES, ISOTOP, WAVNUM, STRNTH, HWIDTH, ENERGY 
GO TO 1 


SEND THIS "WINDOW 1 OF LINES TO SUBROUTINE ATMOS 
//////////////////////////////////////////////// 

20 CALL ATMOS (LINECT) 

RETURN 

END 


SUBROUTINE ATMOS (LINECT) 

SPECIFICATION STATEMENTS 
★★★★★*★*****★★*★★*****★*★★ 


IMPLICIT INTEGER*2 ( I -N ) 

REAL*4 LOWNU 
DIMENSION CS2 (3) , KEEPSW(9) 

NOTE: ST = temp, corrected line intensity 

CS2 = partition func. temp, correction 


COMMON 


* 


Z ( 1 6 ) , 

P(3,16> ,T (3,16) ,W (3,3, 16) , CAY (3,16) ,WG (3,3) , 
TA2(16) ,FA(6,61 ) ,ASC(6,61 ) ,AAB(6,61) , 

HAS ( 1 6> 


DNU(16),CHI(16),HZ1(16),HZ2(16),ITP,JT,KSAM 
BOUND, LOWNU, HI G H NU , D E LNU , V , 

IATMOD, IARMDG , IARMDT, IARMOS, 
NUMPTS,NLINES,KEEPSW, IBLAYR, ITLAYR, 

IRSIZE, HZINT(16) , IAERMD 

DATA CONST, PI /I . 3802 58 E-24 , 3 . 1 41 593 / 

NOTE: CONST= ( R*1 . 0 E-03 ) / ( A*1 . 0 E+05 ) 

= (8.31 44E + 07*1 .0E-03) / (6.0238E + 23*1 .0E+05) 
(R = GAS CONST; A = AVOGADRO'S NUMBER) 


COMMON/BLK1 / 
COMMON/RSETUP/ 



DO 18 IS THE MAJOR COMPUTATIONAL LOOP ON ATMOSPHERIC LAYERS 
WITHIN WHICH MONOCHROMATIC MOLECULAR ABSORPTION COEFFICIENTS 
ARE COMPUTED. 


C 

C 

C 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 


c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


c 


I K 1 = I A TMOD 


(use only this atm. model) 


DO 18 K= I T LA YR , I B LA Y R ! Loop over atm. layers 

★★★★★★★★★★★★★★★★★★★a** 

IF (K.EQ.ITP) GO TO 2 


2 


3 


PBAR=(P(IK1 ,K)+P(IK1 ,K+1))/2.0 
TBAR=(T(IK1 ,K)+T(IK1 ,K+1))/2.0 
PH20=C0NST*TBAR*W(IK1 , 1 , K) / ABS ( Z ( K) -Z ( K+1 ) ) 
GO TO 3 

PBAR=P(IK1 . ITP) 

TBAR=T(IK1 , ITP) 

PH20 = C0NST*TBAR*UG(IK1 ,1) 

CONTINUE 


av . layer pressure 
av. layer temp, 
water vapor pressure 


av. pressure AT GROUND 

av. temp, at ground 

water vapor press, at ground 


DETERMINE CORRECT TEMPERATURE DEPENDENCE OF ROTATIONAL PARTITION 
FUNCTION 


CS2(2) = 296 . 0/TBAR 
CS2C1) = CS2 (2) **1 . 5 
CS2 (3) = CS2C1) 


DO 17 LOOP CYCLES THRU ALL ABSORPTION LINES 
AND ADDS THEIR CONTRIBUTIONS TO THE ABSORPTION 
COEFFICIENT AT THE WAVENUMBER V. 


CAY C I K 1 , K ) = 0.0 
IF (LINECT .EQ. 0) 
IF (IAERMD .EQ. 1) 
REWIND 10 


! initialize for loop over LINES 
GO TO 18 
GO TO 18 

! position pointer to beginning of 10 


DO 17 1=1, LINECT 


! Loop over absorption lines in window 


READ (10) MOL, ISOTOP, GNU, S, ALFAO, EPP 

M = MOL ! Molecular species: 

1 - H20 

2 - C02 
3-03 

ST = S*CS2 (M) *EXP (-EPP* ! temp, corrected line int. 

* (296. -TBAR)/(296.*TBAR*. 6951)) ! (Boltzmann temp. 

correction factor) 


INSERT THE 

ISOTOPIC 

RELATIVE ABUNDANCE FACTOR 

IF 

(M .EQ. 

1 ) 

GO TO 

100 

IF 

(M .EQ. 

2) 

GO TO 

200 

IF 

(M .EQ. 

3) 

GO TO 

300 
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c 

c 

100 


c 

c 

c 

200 


c 

c 

c 

300 

C 

C 

c 

400 

C 

C 

C 


c 

c 

c 


c 

c 

c 

c 


c 

8 

★ 


c 

c 

c 


9 


Water Vapor Isotopes 
RELBUN = 0. 

IF (ISOTOP .EQ. 161) RELBUN = 0.9976 

IF (ISOTOP .EQ. 171) RELBUN = 0.0004 

IF (ISOTOP .EQ. 181) RELBUN = 0.002 

GO TO 400 

Carbon Dioxide Isotopes 


RELBUN = 0. 


I F 

(ISOTOP 

. EQ. 

626) 

RELBUN 

= 0.98418 

I F 

(ISOTOP 

.EQ. 

636) 

RELBUN 

= 0.01103 

I F 

(ISOTOP 

.EQ. 

627) 

RELBUN 

= 0.00079 

IF 

(ISOTOP 

.EQ. 

628) 

RELBUN 

= 0.00394 


GO TO 400 
Ozone Isotopes 
RELBUN = 0. 

IF (ISOTOP .EQ. 666) RELBUN = 1. 

Modify Molecular Abundance 

IF (K .EQ. I TP ) C ON C = RE LBUN*WG ( I K1 , M) 

IF (K .NE. ITP) CON C = RE LBUN*W ( I K1 , M , K) 

INSERT IN PBAR THE WATER VAPOR BROADENING FACTOR 

PEFF=PBAR 

IF (M. EQ. 1) PEFF=PBAR + 4.0*PH20 

SORT (296. /TBAR) IS THE HALF-WIDTH TEMPERATURE CORRECTION FACTOR 

ALPHA L = ALFAO*PEFF*SQRT (296. /TBAR) /I 013.0 
ZDIST=ABS (V-GNU) 

XI =1 .0 

IF (M .NE. 2) GO TO 15 

X1=0.0 
J T 1 = J T-1 

DO 9 L = 1 , J T 1 

IF (ZDIST.GE.DNU(L) .AND.ZDIST. LE.DNU(L + 1 )) GO TO 8 
GO TO 9 

XI = ( (CHI (L + 1 )-CHI (L) ) / (DNU(L + 1 )-DNU(L) ) ) * (ZD I ST-DNU ( L) ) 

+CH I ( L) 

GO TO 15 

CONTINUE 
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c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SINCE PBAR .GT. 10 MB, LORENTZ SHAPE APPLIES. 

NOTE ALSO THAT SINCE WE NEVER CONSIDER PRESSURE LESS THAN 10 MB, 
NEITHER VOIGT SHAPE NOR DOPPLER BROADENING APPLY. 

15 IF ( K .EQ. ITP) GO TO 16 ! (ITP=16 AT ground) 

CAYCIK1 ,K> = CAY ( I K 1 ,K) 

* + ST*ALPHAL*C0NC*X1 /(PI*(ZDIST**2+ALPHAL**2)) 

GO TO 17 


16 CAYCIK1 , K ) = CAYCIK1 ,K) 

* + ST*ALPHAL*C0NC*X1 / (PI*(ZDIST**2+ALPHAL**2)) 


IK1 = atmosphere model index 

K = atmosphere layer index 

M = molecule (1=H20, 2=C02, 3=03) 


17 


18 


CONTINUE 


NOTE : 


CONTINUE 


! End of absorption line loop 

CAY now is the total abs. coeff. 

(ALL lines) for this atm model 
and this layer. 


! End of layer loop 


CLOSE WINDOW FILE AND DELETE IT 
//////////////////////////////// 
CLOSE (UNIT=10, DISP= ' DELETE ' ) 


COMPUTE CONTINUUM ABSORPTION AND AEROSOL EXTINCTION COEFFICIENTS 
//////////////////////////////////////////✓////////////////////// 
CALL CONT (V) 


RETURN 

END 


SUBROUTINE CONT 
C 

C SPECIFICATION STATEMENTS 

C 

IMPLICIT INTEGERS (I-N) 

R E A L*4 LOWNU, CON(20), FN2C91), CN2C91) 
DIMENSION KEEPSWC9) 


C 


C 


COMMON Z ( 1 6 ) , 

★ P (3 , 1 6) , T (3 , 1 6) , W (3 , 3 , 1 6) ,CAY(3,16) ,WG(3,3) ,TA2(16) , 

* FA(6,61) ,ASC(6,61) ,AAB(6,61 ) ,HAS(16) 


★ 

★ 


★ 


COMMON /BLK1 / DNU (1 6) , CH I (1 6) , HZ1 (1 6) , HZ2 <1 6) , ITP, JT.KSAM 
COMMON /RSETUP/ BOUND, LOWNU , H I G H N U , DE LN U , V , 

IATMOD, IARMDG, IARMDT, IARMDS, 
NUMPTS,NLINES,KEEPSW, IBLAYR, ITLAYR, 

IRSIZE, HZINT (16) , IAERMD 
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c 


c 


OATA CON/0.230, 0.187, 0.147, 0.117, 0.097, 0.087, 

* 0.100, 0.120, 0.147, 1.174, 0.200, 0.240, 

* 0.280, 0.330, 6*0.000/ 



DATA FN2/2000. 


2050. , 

2075. , 

2100. 


2125. , 

2150., 

21 55. , 

2160. , 

★ 

2165. 


2170. , 

2175. , 

2180. 


2185. , 

2190. , 

2195. , 

2200. , 

* 

2205 . 


2210. , 

2215. , 

2220. 


2225. , 

2230. , 

2235. , 

2240. , 

★ 

2245 . 


2250. , 

2255. , 

2260. 


2265. , 

2270. , 

2275. , 

2280. , 

* 

2285 . 


2290. , 

2295. , 

2300. 


2305. , 

2310. , 

2315. , 

2320. , 

* 

2325 . 


2330. , 

2335. , 

2340. 


2345. , 

2350. , 

2355. , 

2360. , 

* 

2365. 


2370. , 

2375. , 

2380. 


2385. , 

2390. , 

2395. , 

2400. , 

* 

2405. 


2410. , 

2415. , 

2420. 


2425. , 

2430. , 

2435. , 

2440. , 

* 

2445. 


2450. , 

2455. , 

2460. 


2465. , 

2470. , 

2475. , 

2480. , 

* 

2485 . 


2490. , 

2495. , 

2500. 


2505. , 

2510. , 

2515., 

2520. , 

* 

2525 . 


2530. , 

2535. , 

2540. 


2545. , 

2550. , 

2575. , 

2600. , 

* 

2625 . 


2650. , 

2800./ 









DATA CN2/1 .00E-21 , 

1 . 20 E -07 , 

1 .80E-07, 

6.30E-07, 

2.00E-06, 

* 

9.00E-06, 

1 .13E-05, 

1 .36E-05, 

1 .66E-05 , 

1 . 96E-05 , 

* 

2.16E-05, 

2.36E-05, 

2.63E-05, 

2.90E-05, 

3.1 5E-05, 

• 

3.40E-05, 

3.66E-05, 

3.92E-05, 

4.26E-05, 

4.60E-05, 

* 

4.95E-05, 

5.30E-05, 

5.65E-05, 

6.00E-05, 

6.30E-05, 

* 

6.60E-05, 

6.89E-05, 

7.18E-05, 

7.39E-05, 

7.60E-05, 

* 

7.84E-05, 

8.08E-05, 

8.39E-05, 

8.70E-05, 

9.13E-05, 

* 

9.56E-05, 

1 . 08E-04 , 

1 .20E-04, 

1 . 3 6E-04 , 

1 . 5 2 E-04 , 

# 

1 . 60 E -04 , 

1 . 69E-04 , 

1 .60E-04, 

1 .51 E-04, 

1 . 37E-Q4 , 

* 

1 . 23 E -04 , 

1 .19E-04, 

1 .16E-04, 

1 .14E-04, 

1 . 1 2 E-04 , 

• 

1 .12E-04, 

1.11 E-04, 

1 .11 E-04 , 

1 .1 2E-04, 

1 .14E-04, 

★ 

1 .14E-04, 

1 .12E-04, 

1 .10E-04, 

1 .07E-04, 

1 .02E-04, 

★ 

9.90E-05, 

9.50E-05, 

9.00E-05, 

8.65E-05, 

8.20E-05, 

* 

7.65E-05, 

7.05E-05, 

6.50E-05, 

6.10E-05, 

5.50E-05, 

* 

4.95E-05, 

4.50E-05, 

4.00E-05, 

3.75E-05, 

3.50E-05, 

* 

3.10E-05, 

2.65E-05, 

2.50E-05, 

2.20E-05, 

1 .95E-05, 

★ 

1 .75E-05, 

1 .60E-05, 

1 .40E-05, 

1 .20E-05, 

1 .05E-05, 

« 

9.50E-06, 

6.00E-06, 

3.50E-06, 

2.00E-06, 

1 .50E-06, 

★ 

1 . 00 E -20 / 






C 

C 

C 

C 

C 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


INITIALIZE AEROSOL ABSORPTION AND SCATTERING COEFFICIENTS 
////////////////////////////////////////////////////////// 

D02 K=1,ITP ! loop over 16 atm. layers 

TA2(K) = 0.0 
HAS(K) = 0.0 
CONTINUE 


COMPUTE MOLECULAR CONTINUUM ABSORPTION 
AND RALEIGH (MOLECULAR) SCATTERING, 

AND ADD TO MOLECULAR LINE ABSORPTION 
/////////////////////////////////////// 


J = IATMOD 


(use only this atm. model) 


DO 17 K = I T LA Y R , IBLAYR 


Loop over atm. layers 


TBAR = T(J , ITP) 

PBAR = P(J , ITP) 

IF (K .EQ. ITP) GO TO 100 


Temp, at ground 
Press, at g round 
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PBAR = (P(J,K) + P ( J , K+1 ) ) /2 .0 ! av. layer pressure 

TBAR = ( T ( J , K ) + T(J , K+1 ) )/2.0 ! av. layer temperature 

C 
C 

C RAYLEI6H SCATTERING 

c 

c 

100 IF ( KEEPSW (4) .EQ. 0) GO TO 200 

IF (V .GE. 2740.) GO TO 110 ! waveno. range for this effect 

GO TO 200 
C 

110 IF (K .EQ. ITP) GO TO 120 
IF (K .NE. ITP) GO TO 130 
C 

120 EVM = (273./1013.) * P(J ( ITP) / T(J.ITP) ! ground layer 

GO TO 140 
C 

130 HM = 1 . /ALOG( (P( J , K + 1 )*T(J , K) ) / (P(J , K)*T( J , K + 1 ) ) ) ! other layers 

EVM = (273 . / 1 01 3 . ) * HM * ( <P ( J , K+1 ) /T ( J , K+1 ) ) - (P ( J , K) /T < J , K) ) ) 

C 

140 TM = 9 . 807E-20 * EVM * V**4.0117 
C A Y ( J , X > = CAY ( J , K) + TM 
C 
C 

C 3. 5-4. 2 MICRON H20 CONTINUUM 

C 

C 

200 IF (KEEPSW(5) .EQ. 0) GO TO 300 

IF (V .GE. 2350. .AND. V .LE. 2800.) GO TO 210 ! range of effect 

GO TO 300 
C 

210 XI = (V-2350. ) / 50 . + 1 . 

MH = XI + 1.001 
XH = XI - FLOAT (MH) 

TX5 = CON(MH) 

TX5 = TX5 + XH*(CON(MH)-CON ( M H — 1 ) ) 

C CON T = TX5/3 . 34E22 

TDEP = EXP (4. 56* (296. /TBAR-1 . ) ) 

CNCS = 0.12 * TDEP 
C 

IF (K .EQ. ITP) GO TO 220 
IF (K .NE. ITP) GO TO 230 
C 

220 H20LAY = WG(J,1) ! ground layer 

P H 20 = 1.38E-24 * H20LAY * T(J,ITP) 

GO TO 240 
C 

230 H20LAY =U(J,1,K> ! other layers 

PH20 = 4.712E-23 • H20LAY / A LOG ( P ( J , K + 1 ) / P ( J , K ) ) 

C 

240 ABSOR = (CCONT * ( PH20 + TDEP + C N C S * ( P B AR- PH 2 0) ) / 1 01 3 . ) • H20LAY 
C AY ( J , K ) = C A Y ( J , K ) + ABSOR 
C 
C 
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C 8-14 MICRON H20 CONTINUUM 

c 

C 

300 IF (KEEPSWC6) .EQ. 0) GO TO 400 

IF (V .GE. 700. .ANO. V .LE. 1250.) GO TO 310 ! range of effect 

GOTO400 1 (8-14 microns) 

C 

310 TDEP = EXP (6.08*(296.0/TBAR-1 .0) ) 

CNCS = 0.002 

CCONT = (4.18 + 5578.*EXP(-7.87E-3*V))/3.34E+22 
C 

IF (K .EQ. ITP) GO TO 320 

IF (K .NE. ITP) GO TO 330 
C 

320 H20LAY = WG(J,1) ! ground layer 

PH20 = 1.38E-24 • H20LAY • T(J,ITP) 

GO TO 340 
C 

330 H20LAY = W ( J , 1 , K) ! other layers 

PH20 = 4.712E-23 * H20LAY / A LOG ( P ( J , K + 1 ) /P ( J , K) ) 

C 

340 ABSOR = (CCONT * (PH20*TDEP + C N C S * ( P B AR- PH 20 ) ) / 1 01 3 . ) • H20LAY 
C A Y ( J , K) = C A Y ( J , K ) + ABSOR 
C 
C 

C NITROGEN CONTINUUM 

c 

C 

400 IF (KEEPSW(7) .EQ. 0) GO TO 17 

IF (V .GE. 2000. .AND. V .LE. 2800.) GO TO 410 ! range of effect 

GO TO 17 
C 

410 DO 413 1=1 , 90 

IF (V .GE. F N 2 ( I ) .AND. V .LE. FN2(I + 1)) GO TO 412 
GO TO 413 
C 

412 DELN2 = ( C N 2 ( I +1 ) - C N 2 ( I ) ) / ( F N2 ( I + 1 ) - F N 2 ( I ) ) 

CCONT = DELN2*(V-FN2(I)) + CN2(I> 

GO TO 414 
C 

413 CONTINUE 

c ******** 

c 

414 IF (K .EQ. ITP) GO TO 415 

C 

DELP = P ( J , K + 1 ) - P ( J , K) 

TN 2 = 0.781 * CCONT * (PBAR/1013.) • 29.24 * TBAR * (DELP/1013.) 

GO TO 416 
C 

415 TN 2 = 0.781 * CCONT * ( PB A R / 1 01 3 . ) ** 2 • 1 . 000* 296 . / T ( J , I T P ) 

C 

416 C A Y ( J , K ) = C A Y ( J , K ) + T N 2 
C 

17 CONTINUE ! end of loop over atm. layers 

C 

C 

C 
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c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


COMPUTE AEROSOL ABSORPTION AND SCATTERING COEFFICIENTS 
/////////////////////////////////////////////////////// 

IF ( KE E PS W ( 8 ) .EQ. 0 .AND. KEEPSWC9) .EQ. 0) RETURN 


TEST WHETHER V LIES WITHIN RANGE OF AEROSOL MODEL 


IF (V .LT. F A ( 1 f 1 ) .OR. 

★ V .GT. F A ( 1 , 61 ) ) RETURN ! v out of range of table 

DO 19 J=1 ,60 

IF (V .GE. F A ( 1 , J ) .AND. V .LE. FA(1,J+1>) GO TO 20 

19 CONTINUE 

RETURN ! v above range of table 

20 F AC= (V-FA (1 , J ) ) / CFA (1 , J + 1 ) -FA <1 , J ) ) ! i n t e rpo l a t i ng factor 

(for v not in table) 

IF IT DOES, COMPUTE THE COEFFICIENTS 


DO 32 K=ITLAYR, IBLAYR ! Loop over atm. layers 

*********************** ********************* 

Compute Scaling Factors for Clear and Hazy Aerosol Models 


HZ 1 = vertical scaling factor for clear aerosol model 
HZ2 = " " " " hazy 

HZ1 and HZ2 are given in the block data routine, 
for each of the 16 atmospheric layers; 

EVH1 is just a local variable for this loop. 

IF (K .EQ. I TP ) GO TO 24 

IF (HZINT(K) .EQ. HZINTCK + D) GO TO 21 

H A1 =1 .0/AL0G(HZINT ( K + 1 ) /HZ I NT (K) ) 

EVH1=HA1*(HZINT(K+1)-HZINT(K)) ! effective value 

GO TO 25 

21 EVH1=HZINT (K) 

GO TO 25 

24 EVH1=HZINT (ITP) 

Aerosol model to be used depends on the height Z 


L = aerosol model index 

25 IF ( Z ( K ) .LT. 9.0 .AND. ZOO .GE. 2.0) GO TO 28 
IF ( Z ( K) . LE. 2.0) GO TO 29 

Above 9 km: Use background stratospheric (clear) 
or aged volcanic (hazy) 

IF (IARMDS .EQ. 5) L=5 
IF (IARMDS .EQ. 6) L=6 
GO TO 30 
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c 

c 


28 


Between 2 and 9 km, use tropospheric model 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 


29 


30 


C 

C 

C 

c 

c 

c 

c 

c 

c 


31 


C 


C 

c 

c 


32 


L = 2 
60 TO 30 

Below 2 km, use rural, tropospheric, maritime or urban model 
L = IARMDG 


Compute aerosol extinction coefficients for this layer 


A K = aerosol absorption coeff. at v 
AS = aerosol scattering coeff. at v 

(These are local variables, for this loop.) 

AK = A A B ( L , J ) + FAC*(AAB(L, J+1)-AAB(L, J)) 

AS = A S C ( L , J ) + FAC*(ASC(L,J+1 )-ASC(L,J)) 


Multiply these coefficients by the proper vertical scaling 
factors and store them in the proper arrays in COMMON 


TA2(atm. layer) - aer. abs. coeff. 

H A S ( " " ) - aer. scatt. coeff. 

TA2(K) = E V HI * A K 
HAS(K) = E V H 1 * A S 

IF ( KEEPSW (8) .EQ. 0) TA2 ( K ) = 0. 

IF (KEEPSW(9) .EQ. 0) HAS(K) =0. 

CONTINUE 


RETURN 

END 


C 


BLOCK DATA 

IMPLICIT INTEGER*2 <I-N) 


C 

COMMON /BLK1 / DNU(16),CHI(16),HZ1(16),HZ2(16),ITP,JT,KSAM 

C 

DATA DNU(1 ) , DNU ( 2 ) , DNU (3 ) , DNU ( 4 ) ,DNU(5) ,DNU(6) f DNU ( 7 ) , D NU ( 8 ) , 

DNU (9) , DNU ( 1 0) , DNU ( 1 1 ) , DNU ( 1 2 ) , DNU ( 1 3 ) , DNU ( 1 4) , DNU ( 1 5 ) , 

DNU (16) /0.0,. 5,. 6,. 7,. 8,. 9, 1.0, 1.2, 1.5, 2. 0,2. 5, 3. 0,5. 0,8.0, 
10.0,15.0/ 

C 

DATA CHI(1) , CH I (2) , CH I (3) , CH I (4) , CH I (5) , CHI (6) ,CHI(7),CHI(8) , 

C H I ( 9 ) ,CHI(10) ,CHI(11),CHI (12) ,CHI (13) , C H I (14) ,CHI (15 ) , 

CHI (16) /I .00, 1 .00, .96, .89, .82 , .77, .70, .60, .50, . 41 , .34, .31 , 
.29, .23, .19,0.00/ 
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DATA HZ1 (1 ) , HZ1 (2) , HZ1 (3) , HZ1 (4) , HZ1 (5) , HZ1 (6) , HZ1 (7) , HZ1 (8) , 

HZ1 (9) , HZ1 (10) , HZ1 (11) , HZ 1 (12) , HZ1 (13) , H Z1 (14) , H Z 1 (15) , H Z1 (16) 
/6.43E-04,6.45E-04,6.22E-04,6.63E-04,7.14E-04, 
7.87E-04,9.80E-04,1 . 41 E-03 f 2 . 30E-03 f 3 . 54 E-03 , 
4.85E-03,6.43E-03,8.19E-03,9.70E-03,2.85E-02,6.95E-02/ 

C 

DATA HZ2 ( 1 ) ,HZ2(2) , HZ2 (3 ) , HZ2 (4) , HZ 2 ( 5 ) , HZ2 ( 6 ) , HZ2 ( 7 ) , HZ2 ( 8 ) , HZ2 (9) , 

HZ2 ( 1 0) , HZ2 ( 1 1 ) , HZ2 ( 1 2 ) , HZ2 ( 1 3 ) , HZ2 ( 1 4) , HZ2 ( 1 5 ) # HZ2 ( 1 6) 
/2.92E-03,2.89E~03,2.80E-03 # 2.45E-03,2.11E-03 # 

1 .85 E-03, 1 . 81 E-03, 3 .36E-03, 6. 22 E-03, 7. 71 E-03 , 

9 . 30E-03 , 1 .85E-02,3.46E-02,6.21E-02,7.57E-01 ,7.57E-01 / 

C 

DATA ITP,JT,KSAM /16,16,3/ 

C 

END 


C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


SUBROUTINE LAYNUM (Z, LAYNO, DELHT) 

This subroutine accepts the altitude Z (above sea-level) in km; 
it returns the atmospheric layer number (layno) and the height 
(in km) above the bottom of the layer (delht). 

The layers are numbered as follows: 


HEIGHT Z 
********** 


14 < Z <= 15 km 
13 < Z <= 14 


0 < Z <= 1 
Z = 0 


LAYER NUMBER 
★*****★*★★**★★ 

1 

2 


15 

16 


C 

C 

C 

c 

c 


IF (2 .GT. 15.) Z = 15. 



12 = INT(Z) ! 

DELHT = 2 - FLOAT(IZ) ! 

height of bottom of layer 
height above bottom of layer 

LEVELZ = IZ + 1 ! 

IF (DELHT .EQ. 0.) LEVELZ = IZ 

layer number, 

numbering from ground up 

LAYNO = 16 - LEVELZ ! 

layer number, 

numbering from top down 

RETURN 

END 
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FUNCTION AERSOL(LAYNUM) 


C 

C This subroutine accepts the atmosphere layer number and returns 

C the total aerosol extinction coefficient for that layer; the 
C extinction coefficient is the sum of the aerosol absorption and 
C scattering coefficients. The layers are defined as follows: 

C 

C Height (above sea-level) Layer Number Region 

C 


c 

14 

< 

height 

< = 

15 km 

1 


c 

13 

< 

height 

< = 

14 

2 


c 



. 



. 

St ratosphere 

c 



. 



. 


c 



. 



. 


c 

9 

< 

height 

< = 

10 

6 


c 







c 







c 

8 

< 

height 

< = 

9 

7 


c 



. 



. 


c 



. 



. 

T roposphe re 

c 



. 



. 


c 

2 

< 

height 

< = 

3 

13 


c 







c 







c 

1 

< 

height 

< = 

2 

14 


c 

0 

< 

height 

< = 

1 

15 

Boundary layer 

c 



height 

= 

0 

16 



C 

C The aerosol models to be used for the various regions are specified 

C by the integer variables iarmdg, iarmdt and iarmds; these variables 
C are defined interactively by the user and are stored in the common 
C block RSETUP. 


C 

C 

★ 

c 

* 

★ 

★ 

c 

★ 

c 

400 

C 


R E A L*4 lownu 

DIMENSION keeps w (9) 

COMMON z(16),p(3,16),t(3,16),w(3,3,16),cay(3,16),wg(3,3), 

ta2(16) f fa(6,61),asc<6,61),aab(6 f 61), 
ha s ( 1 6) 

C0MM0N/RSETUP/ bound, Lownu, highnu,delnu,v, 
i a t mod , i a rmdg , i a rmdt , i a rmds , 
numpts,nlines,keepsw,iblayr,itlayr, 
irsize, HZINT(16),iaermd 

IF (V .LT. FA (1 , 1 > -OR. 

V .GT. F A ( 1 , 61 ) ) go to 400 ! out of aerosol model range 

aersol = ta2(laynum) + has(laynum) 
return 

aersol = 0 . 
return 

end 
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AUXILIARY ROUTINES AND COMMAND FILES 

PROGRAM LNEOIT 

This program reads lines one-by-one from an ''original 1 ' line file 
(AFGL format), retains only water, carbon dioxide and ozone lines (all 
isotopes), strips away the quantum identification numbers and writes 
the processed lines out to a "master" line file for use by the 
MICTRA routine. 

The disk containing this program may be run from any drive; 
the drives and filenames for the input and output files will be 
typed in by the user upon prompting by the program, which will halt 
to allow mounting of the input and output disks. 


SPECIFICATION STATEMENTS 

BYTE qntmid, outfil, infil, reply, go 

DIMENSION qntmid(35), outfil(14), i n f i 1(14) 


SPECIFY WAVENUMBER RANGE TO BE INCLUDED IN OUTPUT FILE 
/////////////////////////////////////////////////////// 


type 1 

f o rma t ( / / t 2 , ' Spec i f y wavenumber range to be included', 
t42,'in output file:'/ 
t10,'type minimum wavenumber: ',$) 

accept 2 , wnmi n 
format (f 1 0 . 4) 
type 3 

f o rmat ( t 1 0 , ' t ype maximum wavenumber: ',$) 

accept 2, wnmax 


OPEN THE OUTPUT LINE FILE (for MICTRA; UNformatted, seq. access) 
/////////////////////////////////////////////////////////////////// 


10 


11 


12 


13 


type 10 

format (//t2 f 1 Type name of output file in D L0 : 1 / 

1 2 , ' ( i . e . , the master file, unformatted,'/ 

1 2 , ' to be used by the MICTRA routine): ',$) 

accept 1 1 , outf i l 
format <1 4A1 ) 

type 1 2 

format(//t2, 'Mount disk containing output file,'/ 
t2,'then type * ' G ' ' for ''GO'': ',$) 

accept 13, go 
format C A 1 ) 


OPEN (unit=8, name=outfil, type='NEW' 
d i sp= 1 KEEP ' , form=* UNFORMATTED' 
records ize=6) 


i n i t i a l s i ze = 974 , 
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C OPEN THE INPUT LINE FILE (formatted, sequential access) 

C ///////////////////////////////////////////////////////////// 

C 

C This file should be one of the AF6L files; 

C specify the file name: 

C 

100 t y pe 1 20 
C **★ 

120 format C / / 1 2 , 1 Type name of input file 1 / 

* t2,'(one of the AFGL files): ',$) 

accept 11, infil 

C 

type 126 

126 format(//t2, 'Mount disk containing input file,'/ 

• t2,'then type ''G' 1 for 1 1 GO ' • : ',$) 

ac cept 121, go 

1 21 format ( A1 ) 


C 


C 

C 

C 

C 


C 

C 

C 

C 

C 

C 

C 

C 

C 


C 

C 

C 

C 

C 

C 


C 

C 

C 

C 

C 

c 

c 


OPEN ( u n i t = 4 , name = infil, type= , OLO l , 

* disp='KEEP', form=' FORMATTED') 

OPEN TEMPORARY VM FILE 
/////////////////////// 

199 OPEN (uni t=3 , name= ’ VM : TEMP . DA T ' , type='NEW, 

* disp=' DELETE', fo rm= ' UN FORMATTED ' , 

* initials ize =3 00, records ize=6) 

LOOP - READ LINES ONE AT A TIME, PROCESS AND WRITE TO OUTPUT FILE 
(via temporary VM file, in groups of 6000 lines) 
///////////////////////////////////////////////////////////////// 

Read a line 


l i n e c t = 0 

200 READ (4, 230 , end=300) wavnum, strnth, hwidth, energy, 

* qntmid, idate, ! strip these 

* isotop, molcul 

230 FORMAT ( f 1 0 - 4 , e10.3, f5.4, f10.3, 35a1, i3, i4, i3) 

Reject this line if it is below the minimum wavenumber 
or if it is other than H20, C02 or 03 


IF (wavnum .LT. wnmin) go to 200 
IF (molcul .GT. 3) go to 200 

linect = linect + 1 

Write stripped-down line into temporary VM file (unformatted) 
WRITE(3) wavnum, strnth, hwidth, energy, isotop, molcul 
Branch to appropriate code for given ''end 1 ' condition 


IF (wavnum .GT. wnmax) 
IF (linect .GT. 6000) 
go to 200 


go to 400 
go to 500 

! read another l i ne 
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C End of input file reached 

C 
C 

300 
C 


310 

C 

320 

C 

330 

★ 

★ 

331 


C 

C Maximum wavenumber reached 

c 

400 REWIND 3 

DO 410 1 = 1 , l i nect 

READ (3) wavnum, strnth, hwidth, energy, isotop, molcul 
WRITEC8) wavnum, strnth, hwidth, energy, isotop, molcul 
41 0 cont i nue 

C 

CLOSE (uni t = 3 , d i sp= 1 DELETE ' ) 

CLOSE (uni t = 4 , disp='KEEP*) 

CLOSE (uni t-8 , disp='KEEP'> 

STOP 

C 

C Temporary (VM) file is filled 

C 

C 

500 REWIND 3 

DO 510 I = 1 , l i nec t 

READ (3) wavnum, strnth, hwidth, energy, isotop, molcul 
WRITE(8) wavnum, strnth, hwidth, energy, isotop, molcul 
510 continue 

C 

CLOSE ( un i t =3 , d i sp= 1 DE LETE 1 ) 

60 TO 199 
C 

END 


wn l a s t = wavnum 

IF (linect .EQ. 0) go to 320 

rewind 3 

DO 310 1=1, Li nect 

READ (3) wavnum, strnth, hwidth, energy, isotop, molcul 
WRITE(8) wavnum, strnth, hwidth, energy, isotop, molcul 
continue 

CLOSE ( u n i t =3 , d i sp= ' DE LETE ' > 

CLOSE (uni t = 4 , disp= , KEEP l ) 

type 330, wnlast,wnmax 

format(//t2,'Last wavenumber in this input file is: ' , F 1 0 . 4 / 

1 2 , ' M a x . wavenumber desired for output file is: ',F10.4/ 
t2,'Is the output file complete? (Y or N): ' ,$) 

accept 331 , reply 
format ( A 1 ) 

IF (reply .EQ. 'N') go to 100 
CLOSE ( un i t =8 , disp='KEEP') 

STOP 
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PROGRAM P LOT S P 


This routine plots the spectra computed by MICTRA. 

It automatically plots on an angstrom scale up to 10,000 
angstroms, and on a micrometer scale for wavelengths greater 
than 10,000 angstroms. 

The user has the option of overriding this default to plot 
on an angstrom, micrometer, hertz or wavenumber scale, with 
the scale increasing either to the left or right. 

The routine handles the total range of the Air Force line tapes, 
from 2,000 angstroms to 3 cm. 


BYTE SPCFL1 (15) ,GO,MAPTYP(10) ,BPARAM(10) .BOTTOM (2) , 

LONG, BRIGHT, ARCLIN,LINTYP(2),SH0RT,LEFT(2), 
NORMAL (2) , YES, NO, PLOT, C0MPAR , S TOPP , LHEDNG (21 ) , 
BHDNGAC23) ,ZER0(4) , T EN ( 4 ) ,TWENTY(4) .THIRTY (4) , 
FORTY (4) , FIFTYC4) .SIXTYC4) ,SEVNTY(4) ,EIGHTY(4) , 
NINETY (4) ,HUNDRD(4) ,MAPTPE(10) ,$TDUIN(2) .AXIS, 
BASE, USER, LFTNUM(9) ,RGTNUM(9) ,BHDNGM(25) , 
WLUNITd 2) , UNTDES(41) .ANGST (11) .MICRON (11) , 
REPLY, SCALE, SENSE, BHDNGH(18),BHDN GW (24), 
BEGNUMC12) , ENDNUMC12) ,HERTZ(11 ) , UAVENM (11 ) , 

A , M , R , FTBTCK , FTETCK , F , E 

INTEGER*2 IPARAM(10),PARAM(10),FNX,FNY,FNSPCE,IILNY(11), 
HPARAM (10) 


REA L*4 LOWERW.RPARAM(IO) ,USRWIN(4),SCRWIN(4),LOUERT, 

LOWVAL, LOWU 


COMMON/CMAP/ MAPTPE , 

UXMIN,UXMAX,UYMIN,UYMAX, 
TXMIN,TXMAX,TYMIN,TYMAX, 
STDWIN , 

SXMIN , SXMAX , SYMIN .SYMAX, 
AXIS , BASE 


COMMON/COOROS/ UX.UY, TX.TY, SX.SY 


DATA SPCFL1 /I 5* ' '000/ .MAPTYP/ ' L' , ' I ' , 'N ' ,7* ' '/, 

BP ARAM/ '0 ' ,9* * '/, BOTTOM/ 'A' , 'B'/, LONG/’ L’/, BRIGHT/' B'/, 

ARCLIN/'L'/.LINTYP/'U', 'S'/, SHORT/' S* / , PAR AM/2 , 5 , 8*0/ , 
LEFT/' O',' L'/, NORMA L/'N', ' R ' / , YES / ' Y ' / , NO/ ' N ' / , P LOT / ' P ' / , 
COMPAR/ ' C ' / , STOPP/ 'S'/, 


LHEDNG/ * P ' 

'E' 

, 1 R 

t 

1 

• 

c 1 


E 1 

• N 1 


1 T 1 1 • 

1 * 9 





•T' 

• R 

, 'A 

* 


9 

•s' 


M 1 

1 I 1 


CO 

CO 

I 

, 'O’ , 

'N 


BHDNGA/ ' W ' 

'A' 

* ' V 

t 

•E 

9 

L* 


’E 1 

'N 1 


• G 1 , *T* , 

H 

9 9 



' I ' 

•N* 

i 

i 

i 

1 A 

9 

N 1 


• G 

'S* 


•T*. ' R ’ . 

•o 1 

. |M* , 

'S 


BHDNGM/ 'W 

'A' 

, 9 v 

t 

1 E 

9 

L 1 


‘E 1 

'N 1 


'G'.'T', 

H 

9 9 



' I ' 

• N ' 

t 

t 

•M 

9 

I 1 


C 1 

'R 1 


■O' , 'M' , 

'E' 

,'T'. 



' E' 

• R ' 

, 9 S 

/ 

t 












BHDNGH/'F' 

1 R ' 

, ' E 

* 

1 Q 1 

9 

■u 1 


' E * 

1 N 1 


•C* , ' Y ' , 

i i 

9 



' I ' 

•N' 

i 

t 

t 

1 H 1 

9 

’E 1 


1 R 1 

•T' 


'Z'/, 





BHDNGW/ ' F ' 

'R' 

, ' E 


• Q ' 

9 

■u 1 


1 E 1 

'N 1 


' C ' , ' Y ' , 

i i 

,'I\ 

1 N 1 

9 

i i 

'W 

, ' A 

» 

« v . 

9 

1 E 1 


*N' 

'U' 


•M' , ' B' , 

1 E ' 

, 'R' , 

'S' 

' / 

ZERO/' 

t i 

» 

r 

0 


TEN/ 


i 

9 

i 

9 


1 ' , 'O' /. 







TWENTY/ ' 
FORTY/' ' 
SIXTY/' ' 
EIGHTY/ ' 
HUNDRD/ ' 
CONPLT/ ' C 
HAZY/ ' H ' / 
LFTNUM/9* 
BEGNUH/1 2* 


' , ' 2' , '0 ' / .THIRTY/ ' 
• t '4' f '0'/, FIFTY/' 1 
' , '6' , ’ 0 ' / , SEVNTY / ' 

' , '8' . '0'/, NINETY/ 1 


' ' , '3' , 'O’/. 

'5' , '0'/, 

' . '7' . '0'/. 

' ' , '9' , '0'/, 


.'I'.'O'.'O'/.USER/'U'/.LCPLT/'L'/, 

/ .GODARD/ ' G ' / .MTHOPK/ ' H ' / , CLEAR/ ' C ' / , 
HPARAM/1 ,6,8*0/ , 

'/, RGTNUM/9* ' '/, 

/ , ENDNUM/1 2* ' ’/, 


★ 

UNTDES/ ' l ' 

. 'a' 

, 'r* 

. 'g' 

»p» 1 » l d « til l v l 

9 “ 9 # ” # ' f v # 

'i 

s 

★ 

'o' 

,'n* 

1 * 
9 

i - i 
» “ 

# • ' ,12** ' , ' * ,11*' 

'/. 


★ 

ANGST/'a' , 

*n' . 

'g'. 

's'. 

•t ' , ' r* # 'o 1 , ’m 1 , 's' , • 

I I 

9 

t 

• 

MICRON/ ' m' 

. ' i ' 

. 'C 

. 'r' 

/o’/m'/e'/t'/e’, 

'r' . 

's 

★ 

HERTZ/ ' H ' , 

'E'. 

•R' . 

•T', 

*/, 



★ 

WAVENM/'W' 

. 'A' 

. 'V 

. 'E' 

, ‘N* f 'U' , *M I , - B ' , f E - f 

1 R ' . 

'S 

★ 

A/'A'/, M / 

'M' / 

. R/ 

•R '/ 

, F / 1 F 1 / , E/’E '/ 




DATA C / 2 . 99792 5E1 0/ 


SET UP PLOT SYSTEM 
****************** 

CALL BEGPLT 


C 

C INSTRUCT USER HOW TO USE THIS ROUTINE 

C ************************************* 

CALL TYP100 
TYPE 10 

10 FORMAT (/ /T5 ,' The following options are provided:'// 

* tIS.'Type P to plot a spectrum;'// 

* t15,'Type S to stop this program.'//// 

* t5, 'FIRST type G, RETURN to remove this message 

* t5 , ****** ' //) 

CALL ECHO(YES) 

ACCEPT 11, GO 

11 FORMAT C A 1 ) 

CALL CLR100 
CALL ECHO(NO) 

CALL ALPMOD(I) 


C 

C USE ITTINR TO RECEIVE USER'S INSTRUCTIONS 

1000 ICHAR = ITTINRO 
C 

IF (ICHAR .EQ. PLOT) GO TO 2000 

IF (ICHAR .EQ. STOPP) GO TO 4000 

GO TO 1000 


C 

C PLOT MODE 

C ********* 

2000 CALL TYP100 

CALL ECHO(YES) 

TYPE 2010 

2010 FORMAT(//T5, ' Spectrum file? ',$) 

ACCEPT 2011, S PC F LI 

2011 FORMAT ( 1 5 A 1 ) 

TYPE 2020 

2020 FORMAT (/ /T5 ,' Mount file; when ready, type G: ',$) 
ACCEPT 2021, GO 

2021 FORMAT ( A 1 ) 


c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 


2022 


* 

c 

c 

2023 

★ 

2024 

★ 

★ 

C 

2025 
C 


C 

2026 

2027 


C 


OPEN THE SPECTRUM FILE; READ THE FIRST THREE RECORDS 


OPEN ( UN I T = 1 , N AME = S PC F Li , TYPE= , OLD , # DISP='KEEP*, 
FORM=* UN FORMATTED* , REC0RDSIZE = 2) 


RE AO ( 1 ) 

PLTCOD, ANGMIC 

! Line-center or continuous plot, 
in angstroms or microns 

READ(1 ) 

LOWERW, UPPERW 

! bounding wavelengths 

(in angstroms or microns) 

READCI ) 

ATL, ATU 

! bounding ae ro so l +c on t i nuum 
transmi ssion 


MORE USER'S INSTRUCTIONS 
★★★★★★★★★★★★a*********** 


TYPE 2022 

FORMAT (//// T2 , 1 The spectrum may be plotted on an angstrom,'/ 
t 2 , ' m i c rome t e r , hertz or wavenumber scale,'/ 
t2, 'increasing either to the right or left;'/) 

IF (ANGMIC .EQ. 0.) TYPE 2023 
IF (ANGMIC .EQ. 1.) TYPE 2024 

FORMAT (/ T2 , 1 t h i s spectrum is set up to be plotted on an'/ 
t2, 'angstrom scale, increasing toward the right;'/ 
t2,'do you want to change this? (Y or N): ',$) 

FORMAT(/T2,'this spectrum is set up to be plotted on a'/ 

t2, 'micrometer scale, increasing toward the right;'/ 
t2,'do you want to change this? (Y or N): ',$) 

ACCEPT 2025, REPLY 
FORMAT < A 1 ) 

IF (REPLY .EQ. 'Y') GO TO 2026 
CALL CLR100 
CALL ECHO(NO) 

CALL A LPMOO ( 1 ) 

IF (ANGMIC .EQ. 0.) SCALE = A 
IF (ANGMIC .EQ. 1 .) SCALE = M 
SENSE = R 
GO TO 2032 

TYPE 2027 

FORMAT (// T2 ,' Angs t rom , micrometer, hertz or wavenumber scale?'/ 
t2 , ’ ( A , M , H or W) : ’ ,$) 

ACCEPT 2025, SCALE 


TYPE 2028 

2028 FORMAT ( /T2 ,’ I nc reas i ng toward right or left?'/ 
* t2, ' (R or L) : ' ,$) 

ACCEPT 2025, SENSE 
C 

CALL CLR100 
CALL ECHO (NO) 

CALL ALPMOD (1 ) 

C 
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! unit con- 
version 
factor 


2032 

IF 

(ANGMIC .EQ. 

0. .AND 

. SCALE 

.EQ 

. 1 A ' ) 

CNVFAC 

= 1 . 


IF 

(ANGMIC .EQ. 

0. .AND 

. SCALE 

.EQ 

. 1 M 1 ) 

CNVFAC 

= 1 . E-4 


IF 

(ANGMIC .EQ. 

0. .AND 

. SCALE 

.EQ 

. 'H'> 

CNVFAC 

= -1 . E 8 * C 


IF 

(ANGMIC .EQ. 

0 AND. 

SCALE . 

EQ. 

’W 1 ) 

CNVFAC 

= -1 .E8 


IF 

(ANGMIC .EQ. 

1 AND. 

SCALE . 

EQ. 

'A' ) 

CNVFAC 

= 1 .E4 


IF 

(ANGMIC .EQ. 

1 AND. 

SCALE . 

EQ. 

'M') 

CNVFAC 

= 1 . 


IF 

(ANGMIC .EQ. 

1 AND. 

SCALE . 

EQ. 

'H') 

CNVFAC 

= -1 . E 4 * C 


I F 

(ANGMIC .EQ. 

1 AND. 

SCALE . 

EQ. 

' W' ) 

CNVFAC 

= -1 . E4 


IF 

(CNVFAC .GT. 

0.) GO TO 

2029 



! 

convert wave- 


IF 

(CNVFAC .LT. 

0.) GO TO 

2030 



! 

length bounds 

2029 

LOWERW = CNVFAC 

* LOWERW 







UPPERW = CNVFAC 

* UPPERW 







60 

TO 2031 







2030 

LOWERW = -CNVFAC/LOWERW 
UPPERW = -CNVFAC/UPPERW 






2031 

IF 

(LOWERW .LT. 

UPPERW) 

GO TO 2035 





TEMP = LOWERW 





! 

interchange if 


LOWERW = UPPERW 





! 

necessary to 


UPPERW = TEMP 





| 

keep order 


PLOT THE SPECTRUM (on the 

file just 

opened) 




Compute appropriate wavelength or frequency unit 
to use on plot and number of units required to span plot 

2035 WRANGE = UPPERW - LOWERW 
ORDMAG = A LOG 1 0 (WRANGE) 

IF (ORDMAG .GE. 0.) WUNIT 
IF (ORDMAG .LT. 0.) WUNIT 


10. **(AINT (ORDMAG) ) 
10.**(AINT(0RDMAG)-1 .) 


UPPERW = UPPERW/WUNIT 
LOWERW = LOWERW/WUNIT 


! upper and lower wave- 
! lengths in wunits 


UPPVAL = UPPERW 
LOW V A L = LOWERW 
DIFF = UPPVAL - AINT (UPPVAL) 

UPPVAL = AINT (UPPVAL) 

IF (DIFF .GT. 0.) UPPVAL = UPPVAL + 1. 

LOW V A L = A I NT ( LOWVA L) 

C 

C IUPVAL = INT (UPPVAL) 

C ILWVAL = I NT ( LOWV A L) 

C 

C Set up t he mappi ng 

c 

USRWIN(I) = LOWERW ! define user window 

USRWIN(2) = UPPERW 
USRWIN(3) = 0. 

USRWINU) = 100. 
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! define screen window 


C 

C 

C 

C 

C 

C 

C 


2040 


C 

2045 


C 

2050 

2051 


C 

2060 

2061 


C 


C 

2070 

2071 


C 

C 


SCRWIN(I) = 150. 

SCRUIN(2) = 1000 

IF (SENSE .EQ. 'L'> SCRWIN(I) = 1000. ! scale increasing to left 

IF (SENSE .EQ. * L ’ ) SCRWIN(2) = 150. 

SCRWIN(3) = 170. 

SCRWIN(4) = 770. 

CALL SETMAP (MAPTYP, BPARAM , I PARAM , RPARAM , US R W I N , S C RW I N ) 

Draw a box around the screen window 


CALL BOXWIN 

Draw tick marks and grid lines 


BUCK = 0. 

ANGSTR = LOWVAL- 1. ! draw long vertical ticks 

ANGSTR = ANGSTR + 1. ! and grid lines every 

IF (ANGSTR .GT. UPPERW) GO TO 2045 ! wunit 

IF (ANGSTR .LT. LOWERW) GO TO 2040 

CALL TICK (BOTTOM, LONG, ANGSTR, BRIGHT) 

IF (STICK .EQ. 0.) BTICK = ANGSTR 
ETICK = ANGSTR 

IF (ANGSTR .NE. LOWERW .AND. ANGSTR .NE. UPPERW) 

CALL DRWLIN ( AN G S T R , 0 . , AN G S T R , 1 00 . , A R C L I N , BR I G H T , L I N T Y P , P AR AM ) 

GO TO 2040 

ISWETK = 1 

IF (ETICK .EQ. BTICK) ISWETK = 0 ! eliminate unneeded end tick 

ANGSTR = LOWVAL - 0.1 ! draw short vertical ticks 

ANGSTR = ANGSTR + 0.1 ! every 1/10 th wunit 

IF (ANGSTR .GT. UPPERW) GO TO 2060 
IF (AMOD (ANGSTR , 1 . ) .EQ. 0.) GO TO 2051 

IF (ANGSTR .GE. LOWERW) CALL TICK ( BOTTOM , S HORT , AN G S T R , B R I GHT ) 

GO TO 2051 

TRANS = -10. ! draw long hor. ticks and 

TRANS=TRANS+10. ! grid lines every 10K 

IF (TRANS .GT. 100.) GO TO 2070 
CALL TICK (LEFT, LONG, TRANS, BRIGHT) 

IF (TRANS .GT. 0. .AND. 

TRANS .LT. 100.) 

CALL DRWLIN ( US R W I N ( 1 ) , T R AN S , U S RW I N ( 2 ) , 

TRANS, ARCLIN, BRIGHT, LINTYP, PAR AM) 

GO TO 2061 

TRANS = TRANS - 1. ! draw short hor. ticks 

TRANS = TRANS + 1 . ! every 1 % 

IF (TRANS .GT. 100.) GO TO 2200 
IF (AMOD(TRANS,10.) .EQ. 0.) GO TO 2071 
CALL TICK (LEFT, SHORT, TRANS, BRIGHT) 

GO TO 2071 
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Plot the spectrum 


C 

C 

2200 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

2300 


C 


C 


c 


c 


★ 

2340 

C 


2350 

C 


c 


IF (PLTCOD .EQ. 1.) GO TO 2300 
IF (PLTCOD .EQ. 0.) GO TO 2400 

The aerosol+conti nuum extinction is given precisely enough 
(over a smalt wavelength band) by a straight line, 
having the general form: 

AT = ATI + (AT2-AT1 ) / (W2-W1 ) * (W-W1) , 

where AT = aerosol+continuum transmission in % 
and W = wavelength in angstroms or microns 

( W1 , ATI ) and (W2,AT2) are the two endpoints of the range. 

W1 = LOU E RU ! LINE-CENTER PLOT 

W2 = UPPERW ! (overview) 

ATI = AT L*1 00 . 

AT2 = ATU*1 00 . 

LOWERT = ATI + ( AT2- ATI ) / ( W2-U1 ) * (LOWERW-W1) ! draw aer/con Line 

UPPERT = ATI + (AT2-AT1 ) / (W2-W1 ) • (UPPERW-W1) 

CALL DRWLIN ( LO W E R W , LO W E R T , U P P E R W , U P P E R T , 

ARCLIN, BRIGHT, NORMAL, PA RAM) 

WIDTH = UPPERW - LOWERW ! draw hatched area above line 

HATCHS = WIDTH/50. 

W = LOWERW - WIDTH 
DO 2340 1=1 ,100 
W = W + HATCHS 

AT = ATI + (AT2-AT1 ) / (W2-W1 ) • (W-W1 ) 

CALL DRWLIN (W,AT, W + W I D T H , AT+ 1 00 . , 

ARCLIN, BRIGHT, LINTYP,HPAR AM) 

CONTINUE 

W = UPPERW + WIDTH 
DO 2350 1=1 ,100 

W = W - HATCHS 

AT = ATI + (AT2-AT1 ) / (W2-W1 ) * (W-W1) 

CALL DRWLIN (W,AT, W- W I DT H , A T + 1 00 . , 

ARCLIN, BRIGHT, LINTYP,HPARAM) 

CONTINUE 

2360 READ (1,END=2100) WAVLEN, TRANSM ! draw absorption lines 

IF (CNVFAC .GT. 0.) WAVLEN = CNVFAC * WAVLEN 

IF (CNVFAC .LT. 0.) WAVLEN = -C N V F A C / WA V LEN 

WAVLEN = WAVLEN/WUNIT 

IF (WAVLEN .GT. UPPERW) GO TO 2360 

IF (WAVLEN .LT. LOWERW) GO TO 2100 

AT = ATI + (AT2-AT1 ) / (W2-W1 ) * (WAVLEN-W1) 

CALL DRWLIN (WAVLEN, AT, WAVLEN, TRANSM*100. , 

ARCLIN, BRIGHT, NORMAL, PAR AM) 

GO TO 2360 
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2400 

2410 


* 

2420 


C 

C 

C 

C 2 1 00 
C * 

C 

C 2 1 1 0 
c * 

c * 

c * 

2100 

* 

c 

c 

c * 

c • 

c 

c * 

c * 

c 

C 2 1 20 
C * 

C * 

C * 

★ 

★ 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


IPTCT = 1 ( CONTINUOUS PLOT 

READ ( 1 , EN D = 21 00) WAVLEN, TRANSM 

IF (CNVFAC .GT. 0.) WAVLEN = CNVFAC * WAVLEN 

IF (CNVFAC .LT. 0.) WAVLEN = - C N V F A C / W A V LEN 

WAVLEN = WAVLEN/WUNIT 

IF (IPTCT .EQ. 1) GO TO 2420 

CALL DRWLIN ( W A V LN P , T R A N S P*1 00 . , W A V LEN , TR AN SM* 1 00 . , 

ARC L IN , BRIGHT, NORMAL, PAR AM) 

WAVLNP = WAVLEN 
TRANSP = TRANSM 
IPTCT = IPTCT + 1 
GO TO 2410 

Label the plot 


CALL MO VS E Q ( LH E DN G , 2 1 , 2 , 1 , 700 , -90 . , 20 , ! left heading 

FNX , FNY , FNANGL, FNSPCE) 

PRINT 2110, FNX, FNY, FNSPCE 
FORMAT (/T10, 1 Left heading: 1 // 

1 1 5 , 'X: 1 , 1 20 , 14// 

1 1 5 , *Y: ' , 1 2 0 , 14// 

t 1 5 , 'spacing: ' ,t25,I3///) 

CALL DISPSQ (LHEDNG,21 , BRIGHT, 2, 

42,742,-90. ,33) 


IF (ANGMIC .EQ. 0.) ! bottom heading 

CALL MOVSEQ ( B H D N G A , 23 , 2 , 1,10, 0.,20, 

FNX , FNY , FNANGL, FNSPCE) 

IF (ANGMIC .EQ. 1.) 

CALL MOVSEQ ( B H D N GM , 2 5 , 2 , 1 ,10, 0., 20, 

FNX, FNY, FNANGL, FNSPCE) 

PRINT 2120, FNX, FNY, FNSPCE 
FORMAT(/T10,' Bottom heading:'// 

1 1 5 , 'X: ' , t 20 , 1 4 / / 

1 1 5 , ' Y : ' , t 20 , 1 4 / / 

t15, 'spacing: ' ,t25, 13///) 


I F 

(SCALE 

.EQ. 

' A' ) 

CALL 

DISPSQ 

(BHDNGA,23,BRIGHT,2, 
239,35,0. ,28) 

IF 

(SCALE 

.EQ. 

'M* ) 

CALL 

DISPSQ 

(BHDNGM,25,BRIGHT,2, 
239,35,0. ,28) 

I F 

(SCALE 

.EQ. 

'H' ) 

CALL 

DISPSQ 

(BH0NGH,18,BRIGHT,2, 
239,35,0. ,28) 

I F 

(SCALE 

.EQ. 

'W' ) 

CALL 

DISPSQ 

(BH0NGW,24, BRIGHT, 2, 
239,35,0. ,28) 


Note: MOVSEQ and DISPSQ are two routines from the author's 
plot package, which he wrote to provide acceptable 
plotting capability for the DEC 11/23 microcomputer, 
with a DEC VT100 terminal enhanced with another 
manufacturer's board to give it better plotting 
capability. MOVSEQ allows the user to display any 
string of characters on the screen and move the entire 
string about at will, including changing the angle at 
which the string is displayed, by using the arrow keys 
and other keys on the terminal keyboard; when the 
desired position and orientation of the string have 
been found, MOVSEQ can be commanded to return those 
values, which may then be permanently coded into the 
plot routine. This gives the user a very easy way of 
labelling the plot. 
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C Comment out after get x-value: 

C 

C DSPLFT = (UPPERW-LOUERW) / 20 . 

C UX = LOU E RU - DSPLFT 

C UY = 0. 

C CALL MAP(USER) 


c 


ILNX = 

INT(SX) 


c 


ILNY = 

INT (SY) 


L 

c 


CALL MO VS EQ (ZERO, 4,1, ILNX, 

ILNY, 0 . , 5 , 

c 

r 

* 


FNX, FNY, FNANGL, 

FNSPCE) 

l 

c 


PRINT 

2130, FNX.FNY.FNSPCE 


C 21 30 

FORMAT (/TIO.'Left numbers:’ 

// 

C 

★ 


t15, * X : ' ,t20, 14// 


C 

• 


1 1 5 , 1 Y : ' , t 20 , 14// 


c 

c. . 

★ 


1 1 5 , 'spacing: ' , 1 2 5 , 

13///) 

c 

c 


I I LNX 

= printed x-value for 

'Left numbers 



IILNX 

= 87 


c 


ISPNG 

= printed spacing for 

'Left numbe r s 



ISPNG 

= 15 



2150 


DO 2150 1=1 

,11 

UX = 

LOU E R U 


UY = 

0. + F LOAT ( ( I - 

CALL 

MAP(USER) 

IIX = 

= INT(SX) 

1 1 LNY ( I ) = 

INT(SY) 

CONTINUE 


CALL 

DISPSQ 

(ZERO, 4 

CALL 

DISPSQ 

(TEN, 4, 

CALL 

DISPSQ 

(TWENTY 

CALL 

DISPSQ 

(THIRTY 

CALL 

DISPSQ 

(FORTY, 

CALL 

DISPSQ 

(FIFTY, 

CALL 

DISPSQ 

(SIXTY, 

CALL 

DISPSQ 

(SEVNTY 

CALL 

DISPSQ 

(EIGHTY 

CALL 

DISPSQ 

(NINETY 

CALL 

DISPSQ 

(HUNDRD 

UX = 

BTICK 


UY = 

0 . 


CALL 

MAP(USER) 

IXBTCK = INT(SX) 

IYBTCK = INT(SY) 

UX = 

ETICK 


UY = 

0 . 


CALL 

MAP(USER) 

I X ETC K = INT(SX) 

I Y ETC K = INT(SY) 


I .IILNX, IILNY(1)-6,0. 
, IILNX, IILNY(2)-6,0., 
r, 1 , IILNX, I ILNY(3)-6, 
r, 1 , II LNX, I ILNY<4)-6, 
,1, IILNX, IILNY(5)-6,0 
, 1 , 1 1 LNX, 1 1 LNY (6)-6,0 
,1 , IILNX, IILNY(7)-6,0 
r,1 ,IILN-X,IILNY(8)-6, 
r,1 , IILNX, IILNY(9)-6, 
r,1 , IILNX, 1 1 LNY (1 0) -6 
r, 1 , I I LNX , I I LNY (1 1 > -6 


! map 
! to 


left numbers 


, ISPN6) 
ISPNG) 

0. , ISPNG) 
0. .ISPNG) 

. , ISPNG) 

., ISPNG) 

. .ISPNG) 

0. , ISPNG) 
0. , ISPNG) 
,0. , ISPNG) 
,0. , ISPNG) 


bottom numbers 
screen 
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2161 

2162 

C 


C 

2500 


C 

2600 


C 

2610 


2165 

C 


2166 

C 


BTICK = BTICK * WUNIT ! encode bottom numbers 

ETICK = ETICK • WUNIT 


FTBTCK = E 


IF 

(BTICK . 

GE. 

1 .E- 

4 .AND. 

BTICK .LE. 99999.) FTBTCK = F 

F T ETC K = E 





IF 

(ETICK . 

GE. 

1 . E- 

4 .AND. 

ETICK .LE. 99999.) FTETCK = F 

I F 

(FTBTCK 

.EQ. 

F) 

ENCODE 

(12, 2162, BEGNUM) BTICK 

I F 

(FTBTCK 

.EQ. 

E) 

ENCODE 

(12,2161 .BEGNUM) BTICK 

I F 

(FTETCK 

.EQ. 

F) 

ENCODE 

(12,2162,ENDNUM) ETICK 

IF 

(FTETCK 

. EQ. 

E) 

ENCODE 

(12,2161 .ENDNUM) ETICK 

FORMATCE12. 

5) 




FORMAT ( FI 2 . 

4) 




IF 

(SENSE . 

EQ. 

'R') 

GO TO 

2500 ! adjust positions 

IF 

(SENSE . 

EQ. 

' L* ) 

GO TO 

2600 ! of bottom no's 

I F 

(FTBTCK 

.EQ. 

F) 

IXBTCK 

= MAX0(IXBTCK-7*15,85) 

I F 

(FTBTCK 

.EQ. 

E) 

IXBTCK 

= MAX0(IXBTCK-6*15,85) 

I F 

(FTETCK 

.EQ. 

F) 

IXETCK 

= MIN0(IXETCK-7*15, 1024-12*15) 

I F 

(FTETCK 

. EQ. 

E) 

IXETCK 

= MIN0(IXETCK-6*15, 1024-12*15) 

GO 

TO 2610 





IF 

(FTETCK 

. EQ. 

F) 

IXETCK 

= MAX0(IXETCK-7*15,85) 

IF 

(FTETCK 

. EQ. 

E) 

IXETCK 

= MAX0(IXETCK-6*15,85) 

I F 

(FTBTCK 

. EQ. 

F) 

IXBTCK 

= MIN0(IXBTCK-7*15, 1024-12*15) 

I F 

(FTBTCK 

.EQ. 

E) 

IXBTCK 

= MINO ( IXBTCK-6*1 5 , 1 024-1 2*1 5) 

CALL DISPSQ 

(BEGNUM 

, 12, BRIGHT, 1 , IXBTCK, 100,0. ,15) ! display bottom 

IF 

( ISWETK 

.EQ. 

1 ) 


! numbers 


CALL DISPSQ (ENDNUM, 12, BRIGHT, 1, IXETCK, 100,0-, 15) 

IF (WUNIT .LT. 1.E-4 .OR. WUNIT .GT. 99999.) ! encode scale 

ENCODE (12,2161 ,WLUNIT) WUNIT ! unit 

IF (WUNIT .GE. 1.E-4 .AND. WUNIT .LE. 99999.) 

ENCODE (12,2162,WLUNIT) WUNIT 

DO 2165 1=1,12 
UNTDES(I+17) = WLUNIT(I) 

CONTINUE 


DO 

2166 1= 

1,11 





I F 

(SCALE 

. EQ. 

'A') 

UNTDES (1+30) 

= 

ANGST ( I ) 

I F 

(SCALE 

. EQ. 

1 M 1 ) 

UNTDES ( 1+30) 


MICRON(I) 

I F 

(SCALE 

.EQ. 

' H * ) 

UNTDES ( I +30) 

= 

HERTZ ( I ) 

IF 

(SCALE 

.EQ. 

' W' ) 

UNTDES ( 1+30) 

= 

WAVENM ( I ) 

CONTINUE 






I F 

(SCALE 

. EQ. 

' A' ) 

IXUNT = 250 



I F 

(SCALE 

. EQ. 

• M ' ) 

IXUNT = 265 



IF 

(SCALE 

. EQ. 

• H • ) 

IXUNT = 230 



IF 

(SCALE 

.EQ. 

1 W' ) 

IXUNT = 260 



CALL DISPSQ (UNTDES 

,41 , BRIGHT, 1 , IXUNT, 1 ,0. ,15) 


display scale 
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C CLOSE THE SPECTRUM FILE, CLEAR THE SCREEN 

C AND TAKE NEXT INSTRUCTION AT USER'S CUE 

C ***************************************** 

CLOSE (UNIT=1 ,DISP=' KEEP' ) 

CALL ECHO(YES) 

ACCEPT 2180, GO 
2180 FORMAT ( A1 ) 

CALL ECHO(NO) 

CALL CLR640 
GO TO 1000 
C 
C 

C STOP THE PROGRAM 

C **************** 

4000 CALL ENDPLT 

STOP 
END 
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EDMICB.COM 


COMMAND FILE TO EDIT, DEVELOP AND DEBUG MICTRA 

This command file directs the editing, compilation and linking of 
the MICTRA routines. Any or all of the routines may be edited; 
the edited routines are then compiled and linked with the unedited 
routines to form an updated load module. The user is prompted to 
mount any needed floppy disks, and housekeeping chores (deleting 
unneeded files, squeezing disks, etc) are done automatically. 

LOAD FLOPPIES: OPERATING DISK IN DRIVE 0 
DEVELOPMENT DISK IN DRIVE 1 


RUN C0M:EDMICB.SV1 
INIT/NOQ SD3: 

RUN COM : EDM I CB . SV2 


(Scratch disk is S D 3 ) 

! Tell user to save files 

! Mount floppies in DYO, 

D Y 1 


HOUSEKEEPING 


COPY/NOQ DY1 LST SD3: 
DELETE/NOQ D Y 1 LST 
SQUEEZE/NOQUERY D Y 1 : 


! EDIT AND RECOMPILE MICDRB 

I *************************** 

EDIT DY1 :MICDRB. FOR 

COPY 0Y1 :MICDRB.BAK SD3 : M I C DRB . B AK 
DELETE/NOQUERY 0 Y 1 : M I C DRB . B AK 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ :DY1 : M I C D RB . OB J / CODE : TH R / EXT / U : 1 O/WA/ L I ST : SD3 : M I C DRB 

I 

! EDIT AND RECOMPILE SETUP 

; ************************** 

EDIT D Y 1 :SETUP. FOR 
COPY DY1 :SETUP.BAK SD3 : SETUP . BAK 
DELETE/NOQUERY D Y1 : SETUP . BAK 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ :DY1 : S ETU P . OB J / CODE : THR / EXT/ U : 1 0/ WA / L I ST : S D3 : SETUP 


DY1 :MICDRB. FOR 


D Y 1 : SETUP . FOR 


! EDIT AND RECOMPILE RDTAPE 

! *************************** 

EDIT DY1 : RDTAPE . FOR 

COPY DY1 : RDTAPE . BAK SD3 : RDTAPE . BAK 
DELETE/NOQUERY DY1 : RDTAPE . BAK 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ :DY1 : R DT AP E . OB J / COD E : T H R / EXT /U : 1 0/ WA / L I ST : SD3 : RDT APE DY1 : RDTAPE . FOR 


! EDIT AND RECOMPILE ATMOS 

I ************************** 

EDIT D Y 1 : ATMOS. FOR 
COPY DY1 : ATMOS. BAK SD3 : ATMOS . BAK 
OELETE/NOQUERY D Yl : ATMOS . BAK 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ :DY1 : ATMOS . OB J / CODE : T H R / EXT / U : 1 0 / U A / L I ST : S D3 : ATMOS DY1 : ATMOS. FOR 
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i EDIT AND RECOMPILE CONT 

EDIT D Y1 : CONT . FOR 
COPY D Y 1 : CONT . B A K SD3:CONT.BAK 
DELETE/NOQUERY DYItCONT.BAK 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ :DY1:CONT.OBJ/CODE:THR/EXT/U:10/WA/LIST:SD3:CONT DYItCONT.FOR 


! EDIT AND RECOMPILE BLOCK 

EDIT D Y 1 : B LO C K . FOR 
COPY DY1 : BLOCK . BAK S D3 : B LO C K . B A K 
DELETE/NOQUERY D Y 1 : B LO C K . B A K 
SQUEEZE/NOQUERY D Y 1 : 

FORT /OBJ :DY1 : BLOCK. OBJ /CODE: THR/ EXT/U : 1 O/UA/ LIST: SD3: BLOCK DY1:B LOCK. FOR 


! EDIT AND RECOMPILE LAYNUM 

j **★*********★*★★★★★★★★★★★** 

EDIT D Y 1 : LAYNUM. FOR 
COPY DY1 : LAYNUM. BAK S D3 : L A Y N UM . B A K 
DELETE/NOQUERY D Y 1 : L A Y N UM . B A K 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ : DY1 : LAYN UM. OBJ /CODE :THR/EXT/U:10/WA/ LI ST :SD3: LAYNUM DY1: LAYNUM. FOR 


! EDIT AND RECOMPILE AERSOL 

EDIT DYl : AERSOL. FOR 

COPY DY1 : AERSOL. BAK S D3 : A E R SO L . B A K 
DELETE/NOQUERY D Y 1 : A E R SO L . B A K 
SQUEEZE/NOQUERY DY1 : 

FORT/OBJ :DY1: AERSOL. OBJ /CODE:THR/EXT/U: 10/ WA /LIST: SD3: AERSOL DY1: AERSOL. FOR 


< HOUSEKEEPING 

SQUEEZE/NOQUERY D Y 1 : 


! LINK ENTIRE PROGRAM, THEN DELETE OBJECT MODULES 

! (to save space on disk) 

I ************************************************ 

LINK/EXEC UTE:DY1:MICTRA.SAV/PR0MPT DY1:MICDRB,DY1:SETUP 
DY1 tRDTAPE, DY1 :ATMOS, DY1: CON T,DY1:B LOCK, DY1: LAYNUM 
DY1 : AERSOL, SY: FORLIB// 

! 

DELETE/NOQUERY OY1:(MICORB. OBJ, SETUP. OBJ, RDTAPE. OBJ) 
DELETE/NOQUERY D Y 1 : (ATMOS .OBJ , CONT. OBJ, BLOCK. OBJ) 
DELETE/NOQUERY 0Y1 : ( LAYNUM. OBJ, AERSOL. OBJ) 
SQUEEZE/NOQUERY D Y 1 : 


! COPY MICTRA TO OPERATING DISK (DYO) 

! AND SHOW BOTH DIRECTORIES 

! ************************************ 
COPY DYOtMICTRA.SAV S D3 : M I C B B K . S A V 
DELETE/NOQ DYOtMICTRA.SAV 
SQUEEZE/NOQ DYO: 

COPY DY1 tMICTRA.SAV DYOtMICTRA.SAV 
DELETE/NOQ DYl t M I CTRA . S A V 
COPY /NOQ S D3 : * . LST DYl : 

DIR/ORDER/FULL DYO: 

DIR/ORDER/FULL DYl t 
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! RNMICB . COM 

! This command file, to run the batch version of MICTRA, 

! does nothing but run a FORTRAN program which types on the screen 

! instructions to the user on which further command files to run 

! in order to run the MICTRA batch routine in its various modes. 

! 

RUN C0M:RNMICB.SV1 


RMICB1 . COM 

COMMAND FILE TO RUN MICTRA FROM THE RL02 
IN THE MODE WHICH GENERATES A BATCH FILE 


Initialize the R L 0 2 simulated disks 


RUN COM: RNMICB. LF 
RUN COM : RNMI CB . SVO 
INIT/NOQ S DO : 
INIT/NOQ SD1 : 
INIT/NOQ S D 2 : 
INIT/NOQ SD3: 
INIT/NOQ SCR: 


! Make sure user has a condensed linefile on hand. 

! Tell user to save files before initializing disks 


! Instruct user to load operating MICTRA floppy on DYO: 
! and a floppy containing condensed line files on DYt : 


RUN COM:RNMICB.SV2 

i 

! Copy appropriate files from floppy to simulated disk on RL02 

COPY DYO:MICTRA.SAV S D 2 : M I C T R A . S A V 
COPY DYO: ATMMOD .DAT S D2 : ATMMOD . D AT 
COPY DY1 :*.* SD1 : 


Instruct user how to run MICTRA 
RUN COM : RNM I C B . S V3 


! Run the batch MICTRA routine from the RL02 

RUN SD2:MICTRA.SAV 
! RMICB2.COM 

! COMMAND FILE TO RUN MICTRA FROM THE RL02 

! IN THE MODE WHICH EXECUTES A BATCH FILE 


Initialize the RL02 simulated disks 


RUN COMlRNMICB.LF 
RUN COM : RNM I C B . S00 
INIT/NOQ SD1: 
INIT/NOQ SD2: 
INIT/NOQ SD3 : 
INIT/NOQ SCR: 


Make sure the user has a condensed linefile on hand 
Tell user to save files on disks to be initialized. 
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! Instruct user to load operating MICTRA floppy on DYO: 

! and a floppy containing condensed line files on DY1 : 

RUN COM : RNM I C B . S V2 
\ 

! Copy appropriate files from floppy to simulated disk on R L 0 2 

COPY DYO : M I CTRA . S AV SD2 : M I CTRA . S AV 
COPY D YO : ATMMOD .DAT S D2 : ATMMOD .DAT 
COPY DY1 :*.* SD1 : 

See if batch file is on SDO: 

RUN COM : RNMI CB . SV4 
DIR/ORDER/FULL/VOLUMEID SDO: 

! 

! If not, load a floppy with the batch file into DYO: 

RUN COM : RNMI CB . S V5 


! Run the BATCH compi ler 


3COM : BATCH . COM 


RMICB3 . COM 

COMMAND FILE TO RUN MICTRA FROM THE RL02 
IN THE MODE WHICH GENERATES A BATCH FILE 
AND THEN EXECUTES IT 


Initialize the RL02 simulated disks 


RUN COM : RNMI CB . LF 
RUN COM : RNM I CB . S VO 
INIT/NOQ SDO: 
INIT/NOQ SOI : 
INIT/NOQ SD2 : 
INIT/NOQ SD3 : 
INIT/NOQ SCR: 


! Make sure the user has a condensed linefi le on hand. 
! Tell user to save fi les on disks to be initialized. 


! Instruct user to load operating MICTRA floppy on DYO: 

! and a floppy containing condensed line fi les on DY1 : 

RUN COM:RNMICB.SV2 

j 

! Copy appropriate fi les from floppy to simulated disk on RL02 

COPY DYO : MI CTRA . SAV S D2 : M I CTR A . S A V 
COPY DYO : ATMMOD . DAT SD2 : ATMMOD . DAT 
COPY DY1 :*.* SD1 : 

! Instruct user how to run MICTRA 


RUN COM : RNMI CB . SV3 
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! Run the batch MICTRA routine from the RL02, 
! to create a batch fi le to be executed 

RUN SD2 : M I C T R A . SAV 


! Instruct the user how to respond to BATCH'S prompt 
! for a fi le to be executed (the fi le is SDOrBATFIL.BAT) 

RUN COM : RNM I C B . S V6 


Run the BATCH compiler 


3COM : B ATC H . COM 


! BATCH.COM 
! This command file 
LOAD TT 
! LOAD LP 
LOAD BA 

ASSIGN TT LOG ! (or 
ASSIGN TT LST 
R BATCH 


runs the BATCH compiler 
LP) 


! EDLPLT.COM 

! This command file edits, compiles and links the plot routine PLOTSP, 

! which displays spectra computed by MICTRA 

! 

RUN COM : E D L P LT . S A V ! tell user to save any important files on SDO 

! and to mount the MICTRA operating disk in DYO 

! and the development disk in drive D Y 1 . 

INIT/NOQ SDO: 

EDIT D Y 1 : P LOTS P . FOR 

FORT/OBJ : S DO :P LOT SP.OBJ/CODE:THR/EXT/WA/LIST:S DO :PLOTSP. LST D Y 1 : P LOTS P . FOR 
SQUEEZE/NOQ D Y 1 : 

LINK/EXE:S DO :P LOTSP. SAV S DO :P LOTSP. OBJ , PLT:PLT LIB, SY: FOR LIB 
DELETE / NOQ D YO : P LOTS P . S A V 
SQUEEZE/NOQ DYO: 

COPY S DO : P LOTS P . S A V DYO : P LOTS P . SAV 
DIR/ORDER/FULL/VOLUMEID DYO: 

DIR/ORDER/FULL/VOLUMEID DY1 : 


RNLPLT . COM 

This command file runs the auxiliary plotting routine PLOTSP, 
which displays spectra computed by MICTRA. 


RUN COM:RNLPLT.SAV 

i 

RUN D YO : P LOTS P . S A V 


Tell user to mount MICTRA operating disk 
in drive DYO. 
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! EDLLIN . COM 

! This command file edits, compiles and links the line editing routine 
! LNEDIT, which processes an Air Force line file in ASCII characters 
! into the condensed binary form used by MICTRA. 

» 

RUN COM : ED L L I N . SAV I tell user to save any important files on SDO 

! and to mount the MICTRA operating disk in DYO 

! and the development disk in drive D Y 1 . 

INIT/NOQ SDO: 

EDIT D Y 1 : LNEDIT. FOR 

FORT/OBJ :SD0: LNEDIT. OBJ/CODE:THR/EXT/WA/LIST :SD0: LNEDIT. LST DY1: LNEDIT. FOR 
SQUEEZE/NOQ D Y 1 : 

LINK/EXE:S DO: LNEDIT. SAV S DO: LNEDIT. OBJ, PLT:PLT LIB, SY:FORLIB 
DELETE/NOQ D YO : LN E D I T . S A V 
SQUEEZE/NOQ DYO: 

COPY SDO : LNED IT . SAV DYO : LNED I T . S AV 
DIR/ORDER/FULL/VOLUMEID DYO: 

DIR/ORDER/FULL/VOLUMEID DY1 : 


RNLLIN.COM 

This command file runs the auxiliary line editing routine LNEDIT, 
which processes Air Force line files in ASCII characters into 
the condensed binary form used by MICTRA. 


RUN 

COM: 

RNLLIN.SVl 

! Make 

sure 

user has 

an Air Force ASCII 

! 



line 

file 

at 

hand 


RUN 

COM: 

RNLLIN.SAV 

! Tell 

user 

t 0 

mount 

MICTRA operating disk 

! 



in drive 

DYO. 



RUN 

DYO: 

LNEDIT. SAV 
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ATMOSPHERE AND AEROSOL MODELS 


(These models are on a disk file, in exactly the form shown below; 
the first three lines are the sea-level molecular abundances of H 2 0 , 
C02 and 03, in molecules/sq cm/km, for the three atmosphere models,) 


4.69E+22 8.24E+20 7.53E+16 
1.17E+22 8.95E+20 7.53E+16 
1 . 97E + 2 2 8.41E+20 6.78E+16 


MIDLATITUDE SUMMER 


0.0 

1 . 01 3 E + 03 

294.0 

1 . 4E + 01 

6.0E-05 

1.0 

9 . 020E+02 

290.0 

9.3E+00 

6 . 0E -05 

2.0 

8.020E+02 

285.0 

5.9E+00 

6.0E-05 

3.0 

7.100E+02 

279.0 

3 . 3 E + 00 

6.2E-05 

4.0 

6.280E+02 

273.0 

1 . 9 E + 00 

6.4E-05 

5.0 

5.540E+02 

267.0 

1 . 0E+00 

6.6E-05 

6.0 

4.870E+02 

261 .0 

6.1 E-01 

6.9E-05 

7.0 

4.260E+02 

255.0 

3.7E-01 

7.5E-05 

8.0 

3.720E+02 

248.0 

2.1 E-01 

7.9E-05 

9.0 

3.240E+02 

242.0 

1 . 2 E-01 

8.6E-05 

10.0 

2.810E+02 

235.0 

6.4E-02 

9.0E-05 

1 1 .0 

2.430E+02 

229.0 

2.2E-02 

1 .IE-04 

12.0 

2.090E+02 

222.0 

6.0E-03 

1 . 2 E-04 

13.0 

1 .790E + 02 

216.0 

1 . 8 E-03 

1 . 5 E-04 

14.0 

1 . 530E + 02 

216.0 

1 . 0 E-03 

1 . 8E-04 

15.0 

1 . 3 00 E + 02 

216.0 

7.6E-04 

1 . 9 E-04 

MIDLATITUDE WINTER 



0.0 

1 . 01 8 E + 03 

272.2 

3 . 5 E + 00 

6.0E-05 

1 .0 

8 . 973 E + 02 

268.7 

2 . 5 E + 00 

5.4E-05 

2.0 

7 . 897E+02 

265.2 

1 . 8 E + 00 

4.9E-05 

3.0 

6 . 938 E + 02 

261 .7 

1 . 2 E + 00 

4.9E-05 

4.0 

6.081 E+02 

255.7 

6.6E-01 

4.9E-05 

5.0 

5.313 E + 02 

249.7 

3.8E-01 

5.8E-05 

6.0 

4 . 627 E + 02 

243.7 

2.1 E-01 

6.4E-05 

7.0 

4 . 01 6 E + 02 

237.7 

8.5E-02 

7.7E-05 

8.0 

3 . 473 E + 02 

231 .7 

3.5E-02 

9.0E-05 

9.0 

2 . 992 E + 02 

225.7 

1 .6E-02 

1 .2E-04 

10.0 

2 . 568 E + 02 

219.7 

7 . 5 E-03 

1 . 6E-04 

11.0 

2 . 1 99 E + 02 

219.2 

6 . 9 E-03 

2.1 E-04 

12.0 

1 . 882 E + 02 

218.7 

6 . 0 E-03 

2.6E-04 

13.0 

1 . 61 0E+02 

218.2 

1 . 8E-03 

3 . 0 E-04 

14.0 

1 . 378 E + 02 

217.7 

1 . 0E-03 

3 . 2 E-04 

15.0 

1 . 1 7 8 E + 02 

217.2 

7.6E-04 

3.4E-04 

U.S. STANDARD 




0.0 

1 . 01 3 E + 03 

288.1 

5 . 9 E + 00 

5.4E-05 

1 .0 

8 . 986E + 02 

281 .6 

4 . 2 E + 00 

5.4E-05 

2.0 

7.950E+02 

275.1 

2 . 9 E + 00 

5.4E-05 

3.0 

7.012 E + 02 

268.7 

1 . 8 E + 00 

5.0E-05 

4.0 

6 . 1 66E + 02 

262.2 

1 .1 E+00 

4.6E-05 

5.0 

5 . 405 E + 02 

255.7 

6 . 4 E-01 

4.6E-05 

6.0 

4.722E+02 

249.2 

3.8E-01 

4.5E-05 

7.0 

4.111 E+02 

242.7 

2.1 E-01 

4.9E-05 

8.0 

3 . 565 E + 02 

236.2 

1 . 2 E-01 

5.2E-05 

9.0 

3 . 080E + 02 

229.7 

4.6E-02 

7. IE-05 

10.0 

2 . 650 E + 02 

223.2 

1 . 8 E-02 

9.0E-05 

11 .0 

2 . 270 E + 02 

216.8 

8 . 2 E-03 

1 . 3 E -04 

12.0 

1 . 940 E + 02 

216.6 

3 . 7 E-03 

1 . 6 E -04 

13.0 

1 . 658 E + 02 

216.6 

1 . 8 E-03 

1 . 7E-04 

14.0 

1 . 41 7 E + 02 

216.6 

8.4E-04 

1 . 9E-04 

15.0 

1 . 2 1 1 E + 02 

216.6 

7.2E-04 

2.1 E-04 


E xp l ana t i on : 
*********** 


Atmosphere models 


Column Quantity 


1 

2 

3 

4 


5 


(The density of C02 is calcu- 
lated in the program.) 

Aerosol mode l s 

1 wavelength 
(mi crometers) 

2 ae roso l scatter- 
ing coef f . 

3 aerosol absorp- 
tion coef f i c i ent 


height (km) 
pressure (mb) 
temp. (K) 
dens i t y of 
water vapor 
(g / cub i c m) 
dens i t y of 
ozone 

(g/cub i c m) 


The aerosol coefficients are 
normalized to 1.00 per km 
at 0.55 mi c rometers . 
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RURAL 

40.000 

35.000 

30.000 
27.900 

25.000 

22.500 
21 .300 

20.000 

18.500 

18.000 

17.200 
16.400 

15.000 
14.800 

14.000 

13.000 

12.500 

11.500 

11.000 
10.591 

10.000 

9.800 

9.500 

9.200 

9.000 

8.700 

8.500 

8.200 
7.900 

7.200 

6.500 

6.200 

6.000 

5.500 

5.000 

4.500 

4.000 
3.750 

3.500 
3.392 

3.200 

3.000 

2.700 

2.500 
2.250 
2.000 
1 .800 
1 .536 
1 .300 
1 .060 
0.860 
0.694 
0.633 
0.550 
0.515 
0.488 
0.400 
0.337 
0.300 
0.250 
0.200 


.0231 1 
.02601 
.02807 
.03095 
.03505 
.03883 
.03988 
.04175 
.04276 
.04495 
.0451 2 
.04353 
.03376 
.03926 
.04733 
.05164 
.05370 
.05823 
.05972 
.05749 
.05722 
.05774 
.05477 
.05289 
.0571 9 
.05497 
.03319 
.01340 
.03074 
.0521 6 
.05488 
.05696 
.05870 
.06904 
.07672 
.0801 1 
.09001 
.09394 
.09598 
.09251 
.09339 
.08330 
.07835 
.1016 
.1140 
.1312 
.1535 
.2057 
.2697 
.3802 
.51 22 
.7023 
.7900 
.9307 
1.008 
1 .068 
1 .311 
1.537 
1 .673 
1 .856 
1 .916 


.04972 

.04885 

.04817 

.04713 

.04737 

.04856 

.04959 

.04857 

.04286 

.04387 

.04857 

.04407 

.05278 

.03855 

.03407 

.03310 

.03269 

.03384 

.03607 

.04301 

.05123 

.05266 

.06358 

.0871 9 

.07649 

.07125 

.07937 

.05110 

.03904 

.04713 

.03354 

.03113 

.02921 

.02455 

.02033 

.0221 9 

.01465 

.01357 

.01583 

.01979 

.02046 

.03696 

.06559 

.02932 

.02894 

.02763 

.04432 

.05907 

.06247 

.06775 

.06694 

.06129 

.06159 

.06928 

.06748 

.07050 

.08337 

.09620 

.1335 

.2317 

. 5029 


TROPOSPHERIC 


40.000 

.00006 

.01 807 

35.000 

.00009 

.01730 

30.000 

.0001 2 

.01732 

27.900 

.00017 

.01608 

25.000 

.00026 

.01555 

22.500 

.00040 

.01553 

21 .300 

.00049 

.01616 

20.000 

.00061 

.01 530 

18.500 

.00056 

.01345 

18.000 

.00072 

.01324 

17.200 

.00092 

.01 578 

16.400 

.00068 

.01488 

15.000 

.00046 

.02374 

14.800 

.00049 

.01389 

14.000 

.00075 

.01076 

13.000 

.00104 

.01036 

12.500 

.00122 

.00997 

1 1 . 500 

.00185 

.01027 

11.000 

.00235 

.01108 

10.591 

.00275 

.01 445 

10.000 

.00375 

.01895 

9.800 

.00423 

.01966 

9.500 

.00484 

.02700 

9.200 

.00620 

.04812 

9.000 

.00847 

.03750 

8.700 

.00785 

.0341 9 

8.500 

.00121 

. 04847 

8.200 

.00017 

.02929 

7.900 

.00055 

.01801 

7.200 

.00294 

.02036 

6.500 

.00383 

.01276 

6.200 

.00393 

.01169 

6.000 

.00401 

.01080 

5.500 

.0061 1 

.00805 

5.000 

.00849 

.00623 

4.500 

.01159 

.00701 

4.000 

.01 564 

.00434 

3.750 

.01838 

.00402 

3.500 

.02174 

.00483 

3.392 

.02133 

.00648 

3.200 

.02350 

.00677 

3.000 

.02394 

.01 589 

2.700 

.02650 

.03891 

2.500 

.03797 

.01157 

2.250 

.05005 

.01146 

2.000 

.06761 

.01092 

1.800 

.09904 

.02200 

1 . 536 

.1603 

.03451 

1 .300 

.2313 

.03796 

1 .060 

.3532 

.04336 

0.860 

.4971 

.04326 

0.694 

.7028 

.0391 6 

0.633 

.7983 

.03985 

0.550 

.9528 

.0471 6 

0.515 

1 .037 

.04589 

0.488 

1.102 

.04884 

0.400 

1 .368 

.06144 

0.337 

1 .616 

.07429 

0.300 

1 .766 

.1119 

0.250 

1 .966 

.2184 

0.200 

2.036 

.5090 
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MARITIME 


40-000 

.02533 

.1336 

35.000 

.03006 

.1119 

30.000 

.04085 

.1123 

27.900 

.0461 1 

.1198 

25.000 

.05367 

.1299 

22 . 500 

.061 28 

.1433 

21 .300 

.06514 

.1509 

20.000 

.07033 

.1606 

18.500 

.07484 

.1752 

18.000 

.07611 

.1795 

17.200 

.07504 

.1858 

16.400 

.06689 

.1876 

15.000 

.05950 

.1866 

14.800 

.05801 

.1832 

14.000 

.05448 

.1789 

13.000 

.04841 

.1629 

12.500 

.04623 

.1490 

11.500 

.05652 

.1052 

11.000 

.07216 

.0841 5 

10.591 

.09447 

.06893 

10.000 

. 13066 

.06245 

9.800 

.14392 

.06222 

9.500 

. 1 6085 

.06397 

9.200 

.17855 

.07218 

9.000 

. 1 9546 

.07085 

8.700 

.1996 

.07051 

8.500 

.1848 

.07119 

8.200 

.1869 

.06368 

7.900 

.1988 

.05840 

7.200 

.241 5 

.05965 

6.500 

.2879 

.07387 

6.200 

.28860 

.14480 

6.000 

.19840 

.14880 

5.500 

.34310 

.03207 

5.000 

.40720 

.03660 

4.500 

.45200 

.04247 

4.000 

.52890 

.01985 

3.750 

.56450 

.01718 

3.500 

. 5849 

.04164 

3.392 

.5670 

.08004 

3.200 

.4594 

.2208 

3 .000 

.3271 

.3328 

2.700 

.4399 

.09134 

2.500 

.6093 

.02125 

2.250 

.6772 

.01062 

2.000 

.71 59 

.01380 

1 . 800 

.7534 

.00918 

1 .536 

.7951 

.01 207 

1 .300 

.8288 

.01178 

1 .060 

.8682 

.01210 

0.860 

.9013 

.01084 

0.694 

.9396 

.00979 

0.633 

.9556 

.00996 

0.550 

.9882 

.01179 

0.515 

.9975 

.01147 

0.488 

1 .01 4 

.01221 

0.400 

1 .063 

.01536 

0.337 

1.115 

.01858 

0.300 

1.142 

.02800 

0.250 

1.181 

.05471 

0.200 

1.188 

.13000 
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URBAN 

40.000 

35.000 

30.000 
27.900 

25.000 

22.500 
21 .300 

20.000 

18.500 

18.000 

17.200 
16.400 

15.000 
14.800 

14.000 

13.000 

12.500 

11.500 

11.000 

10.591 

10.000 

9.800 

9.500 

9.200 

9.000 

8.700 

8.500 

8.200 

7.900 

7.200 

6.500 

6.200 

6.000 

5.500 

5.000 

4.500 

4.000 
3.750 

3.500 
3.392 

3.200 

3.000 

2.700 

2.500 
2.250 

2.000 
1 .800 
1 .536 
1 .300 
1 .060 
0.860 
0.694 
0.633 
0.550 
0.515 
0.488 
0.400 
0.337 
0.300 
0.250 
0.200 


.02037 
.02248 
.02422 
.02601 
.02861 
.03099 
.03174 
.03298 
.03376 
.03499 
.03524 
.03457 
.02985 
.03275 
.03713 
.03961 
.04083 
.04350 
.04448 
.04350 
.04365 
.04400 
.04262 
.04181 
.04414 
.04318 
.03205 
.02199 
.03118 
.04271 
.04496 
.04634 
.04767 
.05386 
.05900 
.06220 
.06939 
.07258 
.07500 
.07383 
.07572 
.07209 
.07286 
.08758 
.09833 
.1129 
.1302 
.1670 
.2131 
.2896 
.3828 
.5110 
.5706 
.6657 
.7167 
.7567 
.9171 
1 .065 
1 .1 54 
1 .251 
1 .287 


.04028 
.04112 
.04226 
.04246 
.04374 
.04552 
.04672 
.04691 
.04505 
.04595 
.04911 
.04751 
.05336 
.04621 
.04476 
.04562 
.04604 
.04842 
.05040 
.05493 
.06037 
.06161 
.06802 
.08090 
.07610 
.07416 
.07916 
.06560 
.06030 
.06784 
.06393 
.06492 
.06472 
.06613 
.06824 
.07474 
.07739 
.08063 
.08610 
.08966 
.09346 
.1075 
.1288 
.1157 
.1240 
.1339 
.1524 
.1753 
.1964 
.2256 
. 2545 
.2866 
.3027 
.3343 
.3482 
.3591 
.4036 
.4417 
.4792 
. 5474 
.6767 



BACKGR STRATOSPHERIC 


40.000 

0 . 

.00592 

35.000 

0 . 

.00580 

30.000 

.00001 

.00632 

27.900 

.00001 

.00680 

25.000 

.00001 

.00836 

22.500 

.00002 

.01 530 

21 .300 

.00002 

.01617 

20.000 

.00002 

.01343 

18.500 

.00004 

.01710 

18.000 

.00005 

.02321 

17.200 

.00005 

.04147 

16.400 

.00004 

.03661 

15.000 

.00005 

.01948 

14.800 

.00005 

.01890 

14.000 

.00007 

.01860 

13.000 

.0001 

.01930 

12.500 

.00013 

.01962 

11.500 

.00026 

.03549 

1 1 .000 

.00026 

.05710 

10.591 

.00027 

.04041 

10.000 

.00049 

.04971 

9.800 

.00067 

.07256 

9.500 

.00071 

.09987 

9.200 

.00058 

.08722 

9.000 

.00072 

.09217 

8.700 

.00096 

.1264 

8.500 

.00095 

.1448 

8.200 

.00077 

.1463 

7.900 

.00050 

.1182 

7.200 

.00019 

.04437 

6.500 

.00055 

.03283 

6.200 

.00088 

.04304 

6.000 

.00105 

.05263 

5.500 

.00103 

.05704 

5.000 

.00145 

.04132 

4.500 

.00242 

.04522 

4.000 

.00403 

.05391 

3.750 

.00510 

.06019 

3.500 

.00623 

.07917 

3.392 

.00627 

.08300 

3.200 

.00600 

.07671 

3.000 

.00632 

.05878 

2.700 

.00931 

.00403 

2.500 

. 01 560 

.00289 

2.250 

.02570 

.00157 

2.000 

.04055 

.00128 

1 .800 

.05817 

.00064 

1.536 

.09972 

.00020 

1 .300 

.1642 

.00002 

1 .060 

. 2886 

.00000 

0.860 

.4685 

.00000 

0.694 

.7063 

.00000 

0.633 

.8224 

.00000 

0.550 

1 .000 

.00000 

0.515 

1 .087 

.00000 

0.488 

1.150 

.00000 

0.400 

1 .376 

.00000 

0.337 

1 .515 

.00000 

0.300 

1 .555 

.00000 

0.250 

1 .553 

.00000 

0.200 

1 .487 

.00000 


AGED VOLCANIC 


40.000 

.00002 

.01328 

35.000 

.00003 

.01192 

30.000 

.00006 

.01124 

27.900 

.00008 

.01072 

25.000 

.0001 4 

.01038 

22.500 

.00020 

.01104 

21 .300 

.00023 

.01054 

20.000 

.00026 

.01390 

18.500 

.00031 

.01741 

18.000 

.00031 

.01826 

17.200 

.00029 

.01706 

16.400 

.00028 

.01620 

15.000 

.00032 

.01635 

14.800 

.00033 

.01532 

14.000 

.00046 

.01447 

13.000 

.00071 

.01530 

12.500 

.00090 

.01623 

11.500 

.00191 

.02282 

11 .000 

.00260 

.02511 

10.591 

. 00322 

.02859 

10.000 

. 00449 

.03009 

9.800 

.00475 

.02979 

9.500 

.0051 8 

.02871 

9.200 

.00573 

.02658 

9.000 

.00602 

.02506 

8.700 

.00481 

.02438 

8.500 

.00257 

.02218 

8.200 

.00099 

.02180 

7.900 

.00136 

.01652 

7.200 

.00250 

.01112 

6.500 

.00378 

.00665 

6.200 

.00467 

.00525 

6.000 

.00570 

.00451 

5.500 

.00869 

.00396 

5.000 

.01204 

.00335 

4.500 

.01775 

.00319 

4.000 

.02394 

.00349 

3.750 

.02913 

.00488 

3.500 

.03435 

.00654 

3.392 

.03761 

.00743 

3.200 

.04262 

.00936 

3.000 

.05126 

.00949 

2.700 

.06343 

.00842 

2.500 

.07792 

.00843 

2.250 

.1021 

.00867 

2.000 

.1353 

.01019 

1 .800 

.1849 

.01191 

1 . 536 

. 2648 

.01490 

1 .300 

.3693 

.01881 

1 .060 

. 5057 

.02452 

0.860 

.6570 

.03178 

0.694 

.8079 

.04084 

0.633 

. 8676 

.04532 

0.550 

.9473 

.05271 

0.515 

.9799 

.05651 

0.488 

1 .0030 

.05962 

0.400 

1 .0680 

.07244 

0.337 

1 .0950 

.06497 

0.300 

1 .0790 

.1126 

0.250 

.9009 

.2818 

0.200 

.7006 

.4482 
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